VBA (Excel): Looped copy on multiple criteria in multiple worksheets

Question

Background
I have a master file which holds many sheets of data, and I have a list of requested changes which is constantly being updated. I need to write a macro such that it will run down each row in the Changes sheet and find its counterpart within the actual data sheets. I need to copy the relevant cells from the change sheet to the respective row where it exists in its particular sheet.

Information

• Each observation has a general identifier in Column A (LOBID)
• Also has a specific identifier in Column E (CourseCode)

• Each pair is unique, as each CourseCode can exist within multiple sheets under multiple LOBIDs but will only pair with an LOBID once.

  Sub InputChanges()
  
  Dim changeWS As Worksheet:    Dim destWS As Worksheet
  Dim rngFound As Range:        Dim strFirst As String
  Dim LOBID As String:          Dim CourseCode As String
  Dim i As Integer:             Dim LastRow As Integer
  
  Const SHEET_NAMES As String = "Sheet A, Sheet B, Sheet C, etc."
  Set changeWS = Sheets("Changes")
  
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
  
  For Each destWS In ActiveWorkbook.Worksheets
      If InStr(1, SHEET_NAMES, destWS.Name, vbBinaryCompare) > 0 Then
          For i = 4 To changeWS.Range("A" & Rows.Count).End(xlUp).Row
              LOBID = changeWS.Cells(i, 2)
              CourseCode = changeWS.Cells(i, 5)
              Set rngFound = Columns("A").Find(LOBID, Cells(Rows.Count, "A"), xlValues, xlWhole)
              If Not rngFound Is Nothing Then
                  strFirst = rngFound.Address
                  Do
                      If Cells(rngFound.Row, "E").Value = CourseCode Then
                          Cells(rngFound.Row, "AP").Value = changeWS.Cells(i, 24).Value
                      End If
                      Set rngFound = Columns("A").Find(LOBID, rngFound, xlValues, xlWhole)
                  Loop While rngFound.Address <> strFirst
              End If
          Next i
      End If
  Next
  
  Set rngFound = Nothing
  
  Application.DisplayAlerts = True
  Application.ScreenUpdating = True
  
  End Sub
  

Here's my attempt so far, I have a feeling it's pretty off but I hope the logic at least makes sense. I am attempting to run through each row in the Changes sheet, search through all the Sheets (A, B, C, ... L) for LOBID, then for CourseCode. When a matching pair is found, I'm hoping to copy the value from the changeWS to the matched cell in the datasheet (there are many values to copy but I've left them out for code brevity). It doesn't throw any errors but it doesn't seem to do anything at all. If someone could at least nudge me in the right direction, I'd appreciate it.

Answer 1

Compiled but not tested:

Sub InputChanges()

    Dim changeWS As Worksheet, rw As Range
    Dim i As Integer

    Set changeWS = ActiveWorkbook.Sheets("Changes")

    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

    For i = 4 To changeWS.Range("A" & Rows.Count).End(xlUp).Row

        Set rw = GetRowMatch(CStr(changeWS.Cells(i, 2)), CStr(changeWS.Cells(i, 5)))
        If Not rw Is Nothing Then
            rw.Cells(1, "AP").Value = changeWS.Cells(i, 24).Value
            changeWS.Cells(i, 2).Interior.Color = vbGreen
        Else
            changeWS.Cells(i, 2).Interior.Color = vbRed
        End If

   Next i

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

End Sub

Function GetRowMatch(LOBID As String, CourseCode As String) As Range
    Dim arrSheets, s, sht As Worksheet, rv As Range, f As Range
    Dim addr1 As String
    arrSheets = Array("Sheet A", "Sheet B", "Sheet C") ', etc.")
    For Each s In arrSheets
        Set s = ActiveWorkbook.Sheets(s)
        Set f = s.Columns(1).Find(LOBID, Cells(Rows.Count, "A"), xlValues, xlWhole)
        If Not f Is Nothing Then
            addr1 = f.Address()
            Do
                If f.EntireRow.Cells(5) = CourseCode Then
                    Set GetRowMatch = f.EntireRow 'return the entire row
                    Exit Function
                End If
                Set f = s.Columns(1).Find(LOBID, f, xlValues, xlWhole)
            Loop While f.Address() <> addr1
        End If
    Next s
    'got here with no match - return nothing
    Set GetRowMatch = Nothing
End Function