min order quantities, re-order point and auto email

W

werevollf

New Member
Joined
Sep 5, 2017
Messages
8
Hi All, I have this code in here which looks for print cartridges quantities in columns and if is below certain level (takes from worksheet "Info") it populates email (calls command to create) to order more, records who and when did it and informs to check before ordering more. Thing is it works fine if I have only 2 printers but as soon as I add another one code either stops working and nothing is happening or it creates email even if stock levels are above. So I`m wondering can someone help me out with this?

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim FindString As Date
Dim Rng As Range
Dim ModBy As String
Dim DateBy As Date
Dim Orderdays As Long
Dim Cell1 As Range
Dim Cell2 As Range

'Dim CellAddress1 As String
'Set Cell1 = ThisWorkbook.Worksheets(9).Cells(5, 2)
'CellAddress1 = Cell1.Parent.Name & "!" & Cell1.Address(External:=False)
'Dim Cell2 As Range
'Dim CellAddress2 As String
'Set Cell2 = ThisWorkbook.Worksheets(9).Cells(5, 3)
'CellAddress2 = Cell2.Parent.Name & "!" & Cell2.Address(External:=False)
If Application.WorksheetFunction.IsNumber(Target.Cells) Then
    If Not Intersect(Range("C:C"), Target.Cells) Is Nothing Then
    ModBy = Sheet9.Range("C11").Value
    DateBy = Sheet9.Range("B11").Value
    Orderdays = DateDiff("D", DateBy, Date)
    'Dim CellAddress1 As String
    Set Cell1 = ThisWorkbook.Worksheets("OrderDetail").Cells(11, 2)
    CellAddress1 = Cell1.Parent.Name & "!" & Cell1.Address(External:=False)
    
    'Dim CellAddress2 As String
    Set Cell2 = ThisWorkbook.Worksheets("OrderDetail").Cells(11, 3)
    CellAddress2 = Cell2.Parent.Name & "!" & Cell2.Address(External:=False)
    FindString = dhLastDayInWeek
    Sheet8.Activate
    Range("A:A").Select
            With Range("A:A")
                Set Rng = .Find(What:=FindString, _
                        After:=.Cells(.Cells.Count), _
                        LookIn:=xlFormulas, _
                        LookAt:=xlWhole, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)
                If Not Rng Is Nothing Then
                    Application.Goto Rng, True
                    Else
                    MsgBox "Nothing found"
                End If
            End With
    Rng.Select
    ActiveCell.Offset(0, 2).Select
        If ActiveCell.Value <= Sheets("Info").Range("B2") Then
            If Orderdays >= 8 Then
            If MsgBox("Would you like to send an Email to Order more…?", vbQuestion + vbYesNo) = vbNo Then
            Exit Sub
            End If
            Call Mail_HP_toner_81X
            'Email(, Sheets("Info").Range("C4") & " Bottles of Markem 5005 Black Ink", "Please Order Some More Markem 5005 Black Ink", CellAddress1, CellAddress2)
            'Sheet9.Range("B5").Value = Date
            'Sheet9.Range("C5").Value = fOSUserName
            Else
            msg = MsgBox("An Order was placed by " & ModBy & " on the " & DateBy & vbCrLf & vbCrLf & "Please Check with Laura before Ordering", vbInformation, "Please Check Before Ordering")
            Sheet9.Range("D11").Value = Date
            Sheet9.Range("E11").Value = fOSUserName
            End If
        End If
    Else
    If Not Intersect(Range("L:L"), Target.Cells) Is Nothing Then
    ModBy = Sheet9.Range("C12").Value
    DateBy = Sheet9.Range("B12").Value
    Orderdays = DateDiff("D", DateBy, Date)
    FindString = dhLastDayInWeek
    'Dim CellAddress1 As String
    Set Cell1 = ThisWorkbook.Worksheets("OrderDetail").Cells(12, 2)
    CellAddress1 = Cell1.Parent.Name & "!" & Cell1.Address(External:=False)
    'Dim CellAddress2 As String
    Set Cell2 = ThisWorkbook.Worksheets("OrderDetail").Cells(12, 3)
    CellAddress2 = Cell2.Parent.Name & "!" & Cell2.Address(External:=False)
    Sheet8.Activate
    Range("A:A").Select
            With Range("A:A")
                Set Rng = .Find(What:=FindString, _
                        After:=.Cells(.Cells.Count), _
                        LookIn:=xlFormulas, _
                        LookAt:=xlWhole, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)
                If Not Rng Is Nothing Then
                    Application.Goto Rng, True
                    Else
                    MsgBox "Nothing found"
                End If
            End With
    Rng.Select
    ActiveCell.Offset(0, 5).Select
        If ActiveCell.Value <= Sheets("Info").Range("B3") Then
            If Orderdays >= 8 Then
            If MsgBox("Would you like to send an Email to Order more…?", vbQuestion + vbYesNo) = vbNo Then
            Exit Sub
            End If
            'If Orderdays >= 0 Then
            Call Mail_PR21_22
            'Email(, Sheets("Info").Range("C5") & " Boxes of Markem Cleaning Wipes." & Chr(13) & "An Order was last placed by " & ModBy & " on the " & DateBy, "Please Order Some More Markem Cleaning Wipes", CellAddress1, CellAddress2)
            'Sheet9.Range("B4").Value = Date
            'Sheet9.Range("C4").Value = fOSUserName
            Else
            msg = MsgBox("An Order was placed by " & ModBy & " on the " & DateBy & vbCrLf & vbCrLf & "Please Check with Laura before Ordering", vbInformation, "Please Check Before Ordering")
            Sheet9.Range("D12").Value = Date
            Sheet9.Range("E12").Value = fOSUserName
            End If
        End If
        
         Else
    If Not Intersect(Range("O:O"), Target.Cells) Is Nothing Then
    ModBy = Sheet9.Range("C6").Value
    DateBy = Sheet9.Range("B6").Value
    Orderdays = DateDiff("D", DateBy, Date)
    FindString = dhLastDayInWeek
    'Dim CellAddress1 As String
    Set Cell1 = ThisWorkbook.Worksheets("OrderDetail").Cells(6, 2)
    CellAddress1 = Cell1.Parent.Name & "!" & Cell1.Address(External:=False)
    'Dim CellAddress2 As String
    Set Cell2 = ThisWorkbook.Worksheets("OrderDetail").Cells(6, 3)
    CellAddress2 = Cell2.Parent.Name & "!" & Cell2.Address(External:=False)
    Sheet8.Activate
    Range("A:A").Select
            With Range("A:A")
                Set Rng = .Find(What:=FindString, _
                        After:=.Cells(.Cells.Count), _
                        LookIn:=xlFormulas, _
                        LookAt:=xlWhole, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)
                If Not Rng Is Nothing Then
                    Application.Goto Rng, True
                    Else
                    MsgBox "Nothing found"
                End If
            End With
    Rng.Select
    ActiveCell.Offset(0, 5).Select
        If ActiveCell.Value <= 1 Then ' Sheets("Info").Range("B6") Then
            If Orderdays >= 8 Then
            If MsgBox("Would you like to send an Email to Order more…?", vbQuestion + vbYesNo) = vbNo Then
            Exit Sub
            End If
            'If Orderdays >= 0 Then
            Call Mail_Lex_Rb 
            'Email(, Sheets("Info").Range("C6") & " LEXMARK 11A3540 Ribbons", "Please Order Some More LEXMARK Ribbons for NR01", CellAddress1, CellAddress2)
            'Mail_PR21_22
            'Email(, Sheets("Info").Range("C5") & " Boxes of Markem Cleaning Wipes." & Chr(13) & "An Order was last placed by " & ModBy & " on the " & DateBy, "Please Order Some More Markem Cleaning Wipes", CellAddress1, CellAddress2)
            'Sheet9.Range("B4").Value = Date
            'Sheet9.Range("C4").Value = fOSUserName
            Else
            msg = MsgBox("An Order was placed by " & ModBy & " on the " & DateBy & vbCrLf & vbCrLf & "Please Check with Laura before Ordering", vbInformation, "Please Check Before Ordering")
            Sheet9.Range("D6").Value = Date
            Sheet9.Range("E6").Value = fOSUserName
            End If
        End If
        
        
  ''''''''''''''''''''''''''''''''''''''''''''
    Else 'add one "exit sub" and "end if" for every new entry/printer
    Exit Sub
    End If
    Exit Sub
    End If
    Exit Sub
    End If
Else
Exit Sub
End If
Set Rng = Nothing
Set Cell1 = Nothing
Set Cell2 = Nothing
End Sub

Thanks in advance for the help ;)
 

Excel Facts

When did Power Query debut in Excel?
Although it was an add-in in Excel 2010 & Excel 2013, Power Query became a part of Excel in 2016, in Data, Get & Transform Data.
Sort by date Sort by votes
right I have divided code in 3 parts they all the same only looks from different fields. So basically what happens if I`m using part1 and part2 only - it works, but I`m inserting part3 it messes up. I hope that makes sense



Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim FindString As Date
Dim Rng As Range
Dim ModBy As String
Dim DateBy As Date
Dim Orderdays As Long
Dim Cell1 As Range
Dim Cell2 As Range


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''PART1'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''



'Dim CellAddress1 As String
'Set Cell1 = ThisWorkbook.Worksheets(9).Cells(5, 2)
'CellAddress1 = Cell1.Parent.Name & "!" & Cell1.Address(External:=False)
'Dim Cell2 As Range
'Dim CellAddress2 As String
'Set Cell2 = ThisWorkbook.Worksheets(9).Cells(5, 3)
'CellAddress2 = Cell2.Parent.Name & "!" & Cell2.Address(External:=False)
If Application.WorksheetFunction.IsNumber(Target.Cells) Then
    If Not Intersect(Range("C:C"), Target.Cells) Is Nothing Then
    ModBy = Sheet9.Range("C11").Value
    DateBy = Sheet9.Range("B11").Value
    Orderdays = DateDiff("D", DateBy, Date)
    'Dim CellAddress1 As String
    Set Cell1 = ThisWorkbook.Worksheets("OrderDetail").Cells(11, 2)
    CellAddress1 = Cell1.Parent.Name & "!" & Cell1.Address(External:=False)
    
    'Dim CellAddress2 As String
    Set Cell2 = ThisWorkbook.Worksheets("OrderDetail").Cells(11, 3)
    CellAddress2 = Cell2.Parent.Name & "!" & Cell2.Address(External:=False)
    FindString = dhLastDayInWeek
    Sheet8.Activate
    Range("A:A").Select
            With Range("A:A")
                Set Rng = .Find(What:=FindString, _
                        After:=.Cells(.Cells.Count), _
                        LookIn:=xlFormulas, _
                        LookAt:=xlWhole, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)
                If Not Rng Is Nothing Then
                    Application.Goto Rng, True
                    Else
                    MsgBox "Nothing found"
                End If
            End With
    Rng.Select
    ActiveCell.Offset(0, 2).Select
        If ActiveCell.Value <= Sheets("Info").Range("B2") Then
            If Orderdays >= 8 Then
            If MsgBox("Would you like to send an Email to Order more…?", vbQuestion + vbYesNo) = vbNo Then
            Exit Sub
            End If
            Call Mail_HP_toner_81X
            'Email(, Sheets("Info").Range("C4") & " Bottles of Markem 5005 Black Ink", "Please Order Some More Markem 5005 Black Ink", CellAddress1, CellAddress2)
            'Sheet9.Range("B5").Value = Date
            'Sheet9.Range("C5").Value = fOSUserName
            Else
            msg = MsgBox("An Order was placed by " & ModBy & " on the " & DateBy & vbCrLf & vbCrLf & "Please Check with Laura before Ordering", vbInformation, "Please Check Before Ordering")
            Sheet9.Range("D11").Value = Date
            Sheet9.Range("E11").Value = fOSUserName
            End If
        End If

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''PART2'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''



    Else
    If Not Intersect(Range("L:L"), Target.Cells) Is Nothing Then
    ModBy = Sheet9.Range("C12").Value
    DateBy = Sheet9.Range("B12").Value
    Orderdays = DateDiff("D", DateBy, Date)
    FindString = dhLastDayInWeek
    'Dim CellAddress1 As String
    Set Cell1 = ThisWorkbook.Worksheets("OrderDetail").Cells(12, 2)
    CellAddress1 = Cell1.Parent.Name & "!" & Cell1.Address(External:=False)
    'Dim CellAddress2 As String
    Set Cell2 = ThisWorkbook.Worksheets("OrderDetail").Cells(12, 3)
    CellAddress2 = Cell2.Parent.Name & "!" & Cell2.Address(External:=False)
    Sheet8.Activate
    Range("A:A").Select
            With Range("A:A")
                Set Rng = .Find(What:=FindString, _
                        After:=.Cells(.Cells.Count), _
                        LookIn:=xlFormulas, _
                        LookAt:=xlWhole, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)
                If Not Rng Is Nothing Then
                    Application.Goto Rng, True
                    Else
                    MsgBox "Nothing found"
                End If
            End With
    Rng.Select
    ActiveCell.Offset(0, 5).Select
        If ActiveCell.Value <= Sheets("Info").Range("B3") Then
            If Orderdays >= 8 Then
            If MsgBox("Would you like to send an Email to Order more…?", vbQuestion + vbYesNo) = vbNo Then
            Exit Sub
            End If
            'If Orderdays >= 0 Then
            Call Mail_PR21_22
            'Email(, Sheets("Info").Range("C5") & " Boxes of Markem Cleaning Wipes." & Chr(13) & "An Order was last placed by " & ModBy & " on the " & DateBy, "Please Order Some More Markem Cleaning Wipes", CellAddress1, CellAddress2)
            'Sheet9.Range("B4").Value = Date
            'Sheet9.Range("C4").Value = fOSUserName
            Else
            msg = MsgBox("An Order was placed by " & ModBy & " on the " & DateBy & vbCrLf & vbCrLf & "Please Check with Laura before Ordering", vbInformation, "Please Check Before Ordering")
            Sheet9.Range("D12").Value = Date
            Sheet9.Range("E12").Value = fOSUserName
            End If
        End If
  

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' PART3'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

      
         Else
    If Not Intersect(Range("O:O"), Target.Cells) Is Nothing Then
    ModBy = Sheet9.Range("C6").Value
    DateBy = Sheet9.Range("B6").Value
    Orderdays = DateDiff("D", DateBy, Date)
    FindString = dhLastDayInWeek
    'Dim CellAddress1 As String
    Set Cell1 = ThisWorkbook.Worksheets("OrderDetail").Cells(6, 2)
    CellAddress1 = Cell1.Parent.Name & "!" & Cell1.Address(External:=False)
    'Dim CellAddress2 As String
    Set Cell2 = ThisWorkbook.Worksheets("OrderDetail").Cells(6, 3)
    CellAddress2 = Cell2.Parent.Name & "!" & Cell2.Address(External:=False)
    Sheet8.Activate
    Range("A:A").Select
            With Range("A:A")
                Set Rng = .Find(What:=FindString, _
                        After:=.Cells(.Cells.Count), _
                        LookIn:=xlFormulas, _
                        LookAt:=xlWhole, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)
                If Not Rng Is Nothing Then
                    Application.Goto Rng, True
                    Else
                    MsgBox "Nothing found"
                End If
            End With
    Rng.Select
    ActiveCell.Offset(0, 5).Select
        If ActiveCell.Value <= 1 Then ' Sheets("Info").Range("B6") Then
            If Orderdays >= 8 Then
            If MsgBox("Would you like to send an Email to Order more…?", vbQuestion + vbYesNo) = vbNo Then
            Exit Sub
            End If
            'If Orderdays >= 0 Then
            Call Mail_Lex_Rb 
            'Email(, Sheets("Info").Range("C6") & " LEXMARK 11A3540 Ribbons", "Please Order Some More LEXMARK Ribbons for NR01", CellAddress1, CellAddress2)
            'Mail_PR21_22
            'Email(, Sheets("Info").Range("C5") & " Boxes of Markem Cleaning Wipes." & Chr(13) & "An Order was last placed by " & ModBy & " on the " & DateBy, "Please Order Some More Markem Cleaning Wipes", CellAddress1, CellAddress2)
            'Sheet9.Range("B4").Value = Date
            'Sheet9.Range("C4").Value = fOSUserName
            Else
            msg = MsgBox("An Order was placed by " & ModBy & " on the " & DateBy & vbCrLf & vbCrLf & "Please Check with Laura before Ordering", vbInformation, "Please Check Before Ordering")
            Sheet9.Range("D6").Value = Date
            Sheet9.Range("E6").Value = fOSUserName
            End If
        End If
        
        
  '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Else 
    Exit Sub
    End If
    Exit Sub
    End If
    Exit Sub
    End If



Else
Exit Sub
End If
Set Rng = Nothing
Set Cell1 = Nothing
Set Cell2 = Nothing
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

E
  • Solved
Change the font on Emails
2
Replies
11
Views
544
Eric Penfold
E
R
  • Question
Set sending address - Excel VBA
Replies
3
Views
435
DanteAmor
DanteAmor
lost_in_the_sauce
  • Solved
Add signature to VBA for auto email tabs
Replies
4
Views
825
lost_in_the_sauce
lost_in_the_sauce
M
  • Question
Send email with rows based on expiration date
2
Replies
10
Views
1K
Musto85
M
A
  • Question
Email multiple addresses with multiple rows with VBA Macro
Replies
0
Views
402
atditiljazi
A

Forum statistics

Threads
1,215,001
Messages
6,122,648
Members
449,092
Latest member
peppernaut

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top