Snasui Excel Forum

Code: Select all

Sub lookup()
Application.ScreenUpdating = False
Dim THISM As Range
Dim LASTM As Range
Dim i As Long
Dim match_last As Range
Dim Rng_match As Range
Dim x As Long
Dim y As Long
Dim cell As Range
Dim f As Long
Dim rng As Range
        Set THISM = Worksheets("THISM").Range("C2:HX10000")
        Set LASTM = Worksheets("LastM").Range("C2:HX10000")
        Set match_last = Worksheets("LastM").Range("C1:ZZ1")
        y = 25
        f = y - 1
        For Each rng In Worksheets("THISM").Range("C2:C" & Range("C1").End(xlDown).row)
        On Error Resume Next
        If Not IsEmpty(Cells(1, y - 1)) Then
            rng(1, y) = Application.Vlookup(rng, LASTM, Application.Match(rng(1, f).End(xlUp), match_last, 0), 0)
            rng(1, y + 1) = rng(1, y - 1) - rng(1, y)
        Else
            rng(1, y).Offset(0, 1).Select
    End If
    Next
            
End Sub