Find all specified cell values in directory of workbooks, paste text in offset column

Hi There,

I was wondering if someone could please help me with my VBA code that is not working - The reason why is beyond my skill level. Having extensively looked to tweak other peoples code I am still not getting the result I need. I will try to be as concise as possible: I have some software that generates reports from a large database, generating multiple workbooks for each section, and multiple sheets within each for subsections (The only way the software will do this unfortunately). I have attached a pseudonym example of what I might get out of one spreadsheet.

What I need to do is write some VBA code which will go through all the workbooks within a folder, find any instance of a customer ID (input box) and then change the value (Input box) of the cell 3 columns to the right (this is a fixed offset). As a pseudonym example, I might want to make a comment on all workbooks/worksheets that a specific person had an issue flag up with their account. This would mean anyone accessing these reports would have this helpful note. Each ID could appear in any selection of workbooks(and worksheets within each workbook)

I copied some code from two different sources in the below example, but it only opens all the workbooks.

Sub LoopThroughFiles()
    Dim myID As Variant
    myID = InputBox("Enter Customer ID")
    Dim myResponse As Variant
    meResponse = InputBox("Enter the comment to be entered in all instances")
    Dim xFd As FileDialog
    Dim xFdItem As Variant
    Dim xFileName As String
'Select Folder containing workbooks
    Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
    If xFd.Show = -1 Then
        xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
        xFileName = Dir(xFdItem & "*.xlsx*")
        Do While xFileName <> ""
            With Workbooks.Open(xFdItem & xFileName)
            
'What to do in each workbook
Dim Sh As Worksheet
Dim Loc As Range

For Each Sh In ThisWorkbook.Worksheets
With Sh.UsedRange
        Set Loc = .Cells.Find(What:=myID)
        If Not Loc Is Nothing Then
            Do Until Loc Is Nothing
                Loc.Offset(0.3).Value = myResponse
		ActiveWorkbook.Save
                Set Loc = .FindNext(Loc)
                Loop
                End If
                End With
                Set Loc = Nothing
                Next
'End of routine within each workbook

            End With
            xFileName = Dir
        Loop
    End If
End Sub

Thank you so much in advance for any help with this

Hi AlphaFrog,

This is perfect, worked first time and also worked faster than I anticipated it would! Thank you so much for your help, and I hope it didn't take much time to alter what I had (I can see at least a bit of the original code was retained so it wasn't a complete restart thank goodness)

Best wishes,
Telemanes