IF/ VLOOKUP in a macro

DiKa (Diana)

In the attached, revised file, your example worksheet is now at the end, renamed "Side by side example". (It can be deleted once you've compared results from the macro below).

My solution is to have a worksheet "Source" where you should paste your new raw data (however many columns and rows)..The macro clears then updates the extra (second) sheet called "Output".

Before running the macro, please take a look at the sheet "Output".- I've left some false data in (for the macro to erase).

In the code below, .  The looping depends on the VBA form Cells(<row number >, <column number>) so e.g. Cells(2,3) is cell C2.

The macro (in Module 1) is as follows. I've added comments for your understanding:

Sub UpdateParents()

    Dim WsS As Worksheet, WsO As Worksheet
    Dim Rw As Long, LastRw As Long, LastCol As Long
    Dim ChildCol As Long, GrndParCol As Long
    Dim ParCell As String

    ' name source and output sheets
    Set WsS = Worksheets("Source")
    Set WsO = Worksheets("Output")
    ' state which column contain chld and parent items (assumed to be complete for all rows), same for grandparent
    ChildCol = 4
    GrndPar = 3

    ' find last used row and column (from header row 1)
    LastRw = WsS.Cells(Rows.Count, ChildCol).End(xlUp).Row
    LastCol = WsS.Cells(1, Columns.Count).End(xlToLeft).Column

    'Clear output sheet
    WsO.UsedRange.Clear
    ' add values from first and second rows to output (missed in the loop below)
    WsO.Range(WsO.Cells(1, 1), WsO.Cells(2, LastCol)).Value = WsS.Range(WsS.Cells(1, 1), WsS.Cells(2, LastCol)).Value

    ' loop down used rows from row 3
    For Rw = 3 To LastRw
        ' check for same grandparent and if last digit isn't 1
        If WsS.Cells(Rw - 1, GrndPar).Value = WsS.Cells(Rw, GrndPar).Value And Right(WsS.Cells(Rw, ChildCol), 1) <> "0" Then
            ' if not 0, save the parent value
            ParCell = WsS.Cells(Rw - 1, ChildCol).Value
            ' overwite the previous row
            WsO.Range(WsO.Cells(Rw - 1, 1), WsO.Cells(Rw - 1, LastCol)).Value = WsS.Range(WsS.Cells(Rw, 1), WsS.Cells(Rw, LastCol)).Value
            ' overwrite that with saved parent value
            WsO.Cells(Rw - 1, ChildCol) = ParCell
        End If

        ' write this row to output anyway
        WsO.Range(WsO.Cells(Rw, 1), WsO.Cells(Rw, LastCol)).Value = WsS.Range(WsS.Cells(Rw, 1), WsS.Cells(Rw, LastCol)).Value
    Next Rw

    ' state (in red) when Output was created
    With WsO.Cells(1, LastCol + 2)
        .Value = "Output created " & Now
        .Font.Color = vbRed
    End With
    ' switch to output sheet
    WsO.Activate

End Sub

Run the code and it will erase then add values to the output sheet. Finally it will move to that sheet and  (in row 1, two columns to the right of the data) it will confirm when the output was created, in red.

Hope this fixes your problem. If so, please remember to mark this Answer as Selected.

That is great!! Thank you do much!