Hello,
I am having trouble figuring out how to fix this code and am hoping someone here can help me out. I have the code below to compare sh1 to sh2. The code works fine if my sheet has single rows that meet the criteria. If there is multiple rows that meet the criteria, it will skip over them. I'm not getting any kind of error. The code runs all the way through. It just skips the rows with multiple criteria. Below is the code and parts of each spreadsheet to look at. As you can see in the sample spreadsheets, the notes in red transfer from sh2 to sh1 just fine except for the rows that have the same date more than once in column A. It should insert a row after the last row of the multiple date rows also and insert the note from sh2. I think it is in the part of the code I made red but I do not know how to fix it. Any help would be much appreciated.


Dim sh1 As Worksheet, sh2 As Worksheet, lr As Long, rng As Range, c As Range, fLoc As Range
Dim fAdr As String
Set sh1 = Sheets("Back Orders")
Set sh2 = Sheets("BO Save")
lr = sh1.Cells(Rows.Count, 5).End(xlUp).Row
Set rng = sh1.Range("E7:E" & lr)
    For Each c In rng
        Set fLoc = sh2.Range("E:E").Find(c.Value, , xlValues)
            If Not fLoc Is Nothing Then
                fAdr = fLoc.Address
                Do
                    If Trim(c.Offset(0, -4).Value) = Trim(fLoc.Offset(0, -4).Value) Then
                        If fLoc.Offset(1, 0) = "" And fLoc.Offset(1, -4) <> "" Then
                            c.Offset(1, 0).EntireRow.Insert
                            fLoc.Offset(1, -4).Copy c.Offset(1, -4)
                            c.Offset(1, -4).Columns("A:J").Merge
                        End If
                        Exit Do
                    End If
                    fLoc = sh2.Range("E:E").FindNext(fLoc)
                Loop While fAdr <> fLoc.Address
            End If
    Next
sh1.xlsx

sh2.xlsx