Excel VBA Loop column and copy data

Question

I need some help with a bit of code i'm trying to write. I am not very experienced in VBA, I thought a VLookup is what i needed but after thinking about it. I think a Find loop with work even better.

There will be a button click on sheet1.

The code will need to do the following, in sheet "Global" use column B and search range, each row will have a different value, it will need to search the cell value row by row, in Sheet "Details" if match found then copy the data from columns H, F & E and paste into columns O, P & Q in the Global sheet. H = O, E = P, D = Q. Loop through until first empty row.

In the Details sheet, in column B if there was no data matching from Details then the row will get deleted.

For Example:

Global Before: enter image description here

Details Before: enter image description here

After Code has run:

Global After: enter image description here

Details After: enter image description here

Hopefully this explains it well enough, as you can seen it has found the matching data and copied it to the relevant rows, all non matching data has been deleted.

I have no code at the moment because if i honest i have no idea where to start!!! All help is much appreciated!!

From reading it, I would have thought Vlookup should do what you need. What made you think otherwise? — tea_pea

szaman szaman · Accepted Answer · 2015-06-03T15:21:39

try this. note that you will need to have an empty column that will temporarly hold a mark if the value in the row has been found — in my example i used the "I" column, you will need to modify this if it's not empty.

Private Sub pasteValues()
Dim i, j, lastG, lastD As Long

' find last row
lastG = Sheets("Global").Cells(Rows.Count, "B").End(xlUp).Row
lastD = Sheets("Details").Cells(Rows.Count, "B").End(xlUp).Row

' loop over values in "Global"
For i = 1 To lastG
    lookupVal = Sheets("Global").Cells(i, "B") ' value to find

    ' loop over values in "details"
    For j = 1 To lastD
        currVal = Sheets("Details").Cells(j, "B")

        If lookupVal = currVal Then
            Sheets("Global").Cells(i, "O") = Sheets("Details").Cells(j, "H")
            Sheets("Global").Cells(i, "P") = Sheets("Details").Cells(j, "E")
            Sheets("Global").Cells(i, "Q") = Sheets("Details").Cells(j, "D")
            ' mark the row
            Sheets("Details").Cells(j, "I") = "marked"

        End If
    Next j
Next i

' loop over rows in "details" and delete rows which have not been marked
For j = 1 To lastD
    If Sheets("Details").Cells(j, "I") <> "marked" Then
        ' delete unmarked rows
        Sheets("Details").Cells(j, "A").EntireRow.Delete
        If Sheets("Details").Cells(j, "B") <> "" Then
            j = j - 1 ' revert iterator so it doesn't skip rows
        End If
    Else:
        ' remove the mark
        Sheets("Details").Cells(j, "I") = ""
    End If
Next j
End Sub

Excel VBA Loop column and copy data

1 Answers