Match, Find, Offset & Sum in loop not working

[Paul_Hossler]

In my data for the first 4 rows in col R, columns I8 = 8323.91, I27 = 37.13, I46 = 12.59 & I65 = 810.79

I think your example is wrong for the last two

For example

I46 = 12.6 for 1507 and R9 for 1507 = 0.01 making the new I46 = 12.61


Any way, try this and let me know

Option Explicit

Sub FiddleNumbers()
    Dim r1 As Range, r2 As Range, rBlanks As Range, rBlank As Range
    Dim nCode As Double, nAdj As Double
    
    Set r1 = ActiveSheet.Range("D7").CurrentRegion
    Set r2 = ActiveSheet.Range("O7").CurrentRegion
    Set rBlanks = r1.Columns(6).SpecialCells(xlBlanks)


    For Each rBlank In rBlanks.Cells
        nCode = rBlank.Offset(0, -5).Value
        
        nAdj = 0#
        On Error Resume Next
        nAdj = Application.WorksheetFunction.VLookup(nCode, r2, 4, False)
        nAdj = Round(nAdj, 2)
        On Error GoTo 0
        
        rBlank.Offset(1, 0).Value = rBlank.Offset(1, 0).Value + nAdj
    Next
End Sub