VBA - Find value in another sheet, add date in next column

[si3po]

hi folks,

wondering if you knowledgeable people can help with this code.


I have written the following code and need some guidancewith it please.


I run a WB that tracks make-to-order demands with a longlead-time. Within the WB I have a sheet called ‘Hastener’ that I use toperiodically chase customers to confirm their outstanding Orders are still required.


The ‘Hastener’ sheet is set up to collect all demands for onecustomer based on their customer ID, e.g. ‘BXT’ or ‘CJP’ and list all of demandson the same sheet. I have a command button currently programmed to send anemail and copy/paste all of the demands for that customer that works perfectly.However, I am finding it difficult to track which demands have already beenchased and how many times – if after a number of hasteners I get no reply I willcancel the order.


Now, I have a sheet called 'Master Sheet’ that collates alldata about every outstanding order – when it was placed, what it is for, order number,customer id etc. I have adapted the sheet to allow manual updating of hasteners sent, but for some customers there aremany demands, and it is very laborious and repetitive to enter this info.


I have written the following code to help me update each demandchased with a customer, but I can’t work out how to get it to loop through alldemands chased on my ‘hastenerÂ’ and find their corresponding record on the ‘MasterSheet’ and update the date chased in column K of the ‘Master Sheet’.

[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]Dim rFind As Range[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000]With Sheets("Master Sheet").Columns(6)[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]Set rFind =.Find(What:=Sheets("Hastener").Range("H:H"),LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]If Not rFind IsNothing Then[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]rFind.Offset(0, 5) = Format(Now(), "dd/mmm/yy")[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]End If[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000]End With[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]End Sub[/COLOR][/SIZE][/FONT][FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]

Any assistance offered is greatly appreciated.

Simon

 

[si3po]

I know it's not been a day yet, but I've been working away at this and tried a different approach, but still can't get it to put the date into column K of 'Master Sheet' if the search string from the 'Hastener' sheet Col H matches that of the value in Col F 'MasterSheet'.

Sub HastenEmail()
' following actions skipped for time being - reinstate when rest of script is finished
'    Application.Run "Sheet16.UnHide_Rows"
'    Application.Run "Sheet16.Mail_Selection_Range_Outlook_Body"
'    Application.Run "Sheet16.NoSelect"
'    Application.Run "Sheet16.Hide_Rows"
'    Application.Run "Sheet16.PastetoLast"


Dim FindWhat As String
    Dim finalrow As Integer
    Dim i As Integer
    Dim ctrSearchRow As Integer
    
    FindWhat = Sheets("AinU Hastener").Range("H22").Value
    finalrow = Sheets("Master Sheet").Range("A5000").End(xlUp).Row

       For i = 9 To finalrow
           For ctrSearchRow = 9 To 100
                FindWhat = Sheets("Master Sheet").Cells(ctrSearchRow, 6).Value
                If Len(FindWhat) > 0 Then
                    If StrComp(Cells(i, 2).Value, FindWhat, vbTextCompare) = 0 Then
                        Cells(i, 11).Value = Format(Now(), "dd-mmm-yyyy")
                        End If
                End If
            Next ctrSearchRow
        Next i
End Sub

is anybody able to see where I'm going wrong and possibly correct me??

 

[si3po]

hi all,

another quick update to my code, and I'm still looking for help is possible....

the following now works for the value in H42, but not the remainder of my filtered values in Col H.

Sub AinUEmail()
' following actions skipped for time being - reinstate when rest of script is finished
'    Application.Run "Sheet16.UnHide_Rows"
'    Application.Run "Sheet16.Mail_Selection_Range_Outlook_Body"
'    Application.Run "Sheet16.NoSelect"
'    Application.Run "Sheet16.Hide_Rows"
'    Application.Run "Sheet16.PastetoLast"
Dim FindWhat As String
Dim i As Integer                                                   'assumes you are on AinU Hastener Sheet when activating macro
FindWhat = Sheet16.Range("h42").Value                              'the value you want to match against is in this cell AinU Hastener
finalrow = Sheet2.Range("a3000").End(xlUp).Row                     'finds last row in Master Sheet
Sheet2.Activate                                                    'switches to Master Sheet
    For i = 9 To finalrow                                          'skip headers and loop through all rows from 9 to last row
        If FindWhat = Sheet2.Cells(i, 7).Value Then                'if the value in col F (7th col) of Master Sheet matches value in H22 of AinU Hastener
            Cells(i, 13).Value = Format(Now(), "DD-MMM-YYYY")      'change value of Col M (13th col) in Master Sheet to todays date
        End If                                                     'end if
    Next i                                                         'evaluate next row
    
Sheet16.Activate                                                   'return to AinU Hastener sheet
End Sub