Problem With Existing Code After PC Upgrade

[Dazzawm]

I have gone from a windows 7 32-bit to a windows 11 64-bit PC. The code below is doing opposite to what it should! I have sheet 2 with a number in A and another in B. When the number in A is found in column AE on sheet 1 it is supposed to copy the row and insert below and replace with the number that is next to it in column B sheet 2. But it inserts the row above instead! Would somebody help please?

Sub FindCopyReplaceBelow()
Application.EnableEvents = False
Application.Calculation = xlCalculationManual = False
Application.ScreenUpdating = False


Dim Rng1    As Range
Dim Dn1     As Range
Dim Rng2    As Range
Dim Dn2     As Range
With Sheets("Sheet2")
    Set Rng2 = .Range(.Range("A1"), .Range("A" & Rows.Count).End(xlUp))
End With
With Sheets("Sheet1")
    Set Rng1 = .Range(.Range("AE2"), .Range("AE" & Rows.Count).End(xlUp))
End With
    For Each Dn2 In Rng2
        For Each Dn1 In Rng1
            If Dn1 = Dn2 Then
                Dn1.EntireRow.Interior.ColorIndex = 5
                Dn1.EntireRow.Copy
                Dn1.Offset(1).EntireRow.Insert Shift:=xlDown
                Dn1.Offset(1).Resize(, 2).Value = Dn2.Offset(, 1).Resize(, 2).Value
                
                
            End If
        Next Dn1
    Next Dn2
    
Application.EnableEvents = True
Application.Calculation = xlCalculationManual = True
Application.ScreenUpdating = True
End Sub

 

[Takae]

Hope this helps.

Sub FindCopyReplaceBelow()
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual = False
    Application.ScreenUpdating = False
    
    
    Dim Rng1    As Range
    Dim Dn2     As Range
    Dim i As Long
    
    With Sheets("Sheet1")
        Set Rng1 = .Range(.Range("AE2"), .Range("AE" & Rows.Count).End(xlUp))
    End With
    
    With Sheets("Sheet2")
        For i = .Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
            If WorksheetFunction.CountIf(Rng1, .Cells(i, 1).Value) > 0 Then
                Rows(i).EntireRow.Interior.ColorIndex = 5
                Rows(i).EntireRow.Copy
                Rows(i + 1).EntireRow.Insert Shift:=xlDown
                .Cells(i + 1, 2).Value = .Cells(i, 3).Value
            End If
        Next
    End With
    
    Application.EnableEvents = True
    Application.Calculation = xlCalculationManual = True
    Application.ScreenUpdating = True
End Sub

 

[davesexcel]

My results come out as expected,using your code

 

[Dazzawm]

Hope this helps.

Sub FindCopyReplaceBelow()
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual = False
    Application.ScreenUpdating = False
   
   
    Dim Rng1    As Range
    Dim Dn2     As Range
    Dim i As Long
   
    With Sheets("Sheet1")
        Set Rng1 = .Range(.Range("AE2"), .Range("AE" & Rows.Count).End(xlUp))
    End With
   
    With Sheets("Sheet2")
        For i = .Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
            If WorksheetFunction.CountIf(Rng1, .Cells(i, 1).Value) > 0 Then
                Rows(i).EntireRow.Interior.ColorIndex = 5
                Rows(i).EntireRow.Copy
                Rows(i + 1).EntireRow.Insert Shift:=xlDown
                .Cells(i + 1, 2).Value = .Cells(i, 3).Value
            End If
        Next
    End With
   
    Application.EnableEvents = True
    Application.Calculation = xlCalculationManual = True
    Application.ScreenUpdating = True
End Sub

Thanks but that doesn't do anything?

 

[Dazzawm]

I think I know why but don't understand why. When I run the code normally from the list of macros in my PMW it runs as it should. But when I add it to QAT this is when it fails and does as above?