Home » excel » excel – VBA: if value found in reference sheet, then pull data + fields from source sheet into destination sheet

excel – VBA: if value found in reference sheet, then pull data + fields from source sheet into destination sheet

Posted by: admin May 14, 2020 Leave a comment

Questions:

I have data in 2 sheets; a reference sheet with a list of Case ID’s and a source sheet with Case ID’s, client names, numbers, descriptions, etc.

The goal is to create a VBA loop that checks each row of the source sheet against the reference sheet and if the value is present in the reference sheet, pull in all required fields from the source sheet into the Destination sheet. My current VBA code is using an offset, but that doesn’t seem to work correctly. Code below:

Public Sub MainFileData2()

Dim i As Long, k As Long

Dim wbmacro As Workbook
Dim wbmain As Workbook

Set wbmacro = Workbooks.Item("MacroFile.xlsm")
Set wbmain = Workbooks.Item("SourceFile.csv")

Dim wsmacro As Worksheet
Dim wsmain As Worksheet
Dim wsref As Worksheet

Set wsmacro = wbmacro.Worksheets.Item("Data")
Set wsmain = wbmain.Worksheets.Item("SourceFileData")
Set wsref = wbmacro.Worksheets.Item("Sheet1")
Set destsht = Workbooks("MacroFile.xlsm").Worksheets("Data")

Dim engrange As Range
Set engrange = wsmain.Range("B2:B500000")

Dim cell As Range

k = 1
i = 2
DestLastRow = destsht.Cells(destsht.Rows.Count, 1).End(xlUp).Row


Application.ScreenUpdating = False

For Each cell In engrange

    If engrange.Cells(i, 1) = wsref.Cells(k, 1) Then

        wsmacro.Range("candnum").Offset(i, 0) = wsmain.Range("b2").Offset(i, 0)
        wsmacro.Range("candname").Offset(i, 0) = wsmain.Range("c2").Offset(i, 0)
        wsmacro.Range("estat").Offset(i, 0) = wsmain.Range("e2").Offset(i, 0)
        wsmacro.Range("ira").Offset(i, 0) = wsmain.Range("g2").Offset(i, 0)
        wsmacro.Range("wrkflw").Offset(i, 0) = wsmain.Range("k2").Offset(i, 0)
        wsmacro.Range("fln").Offset(i, 0) = wsmain.Range("o2").Offset(i, 0)
        wsmacro.Range("city").Offset(i, 0) = wsmain.Range("r2").Offset(i, 0)
        wsmacro.Range("country").Offset(i, 0) = wsmain.Range("s2").Offset(i, 0)

        i = i + 1

        Else: i = i + 1


    End If

Next cell

Application.ScreenUpdating = True


End Sub

As the code cycles through i, it finds the value at row 20 in the Source File, for example and ends up pasting the values all the way into row 20 in the Destination File (“Data” sheet), skipping the first 19 blank rows. I tried using destlastrow instead of i and it ended up overwriting the value and didn’t work correctly either.

Any ideas/input would be appreciated. Thanks in advance.

How to&Answers:

There are quite few major issues with your code. Not trying to be harsh, but hopefully it will help you understand the changes I’m proposing.

You have two variables to use as indices (i,k), but you’re only incrementing i. k stays the same the whole time. That’s why you’re only getting output in 1 row.

You’ve also used a For Each loop which essentially adds another set of invisible indices for the same data set you’re using on i. You’re better off using a For loop with i, which will eliminate the need for i=i+1, and creating enrange.

Also, within the IF statement section of your code, you’re using i on either side of the = sign, which is why you’re getting your 1 result output on wsmacro in the same row that it’s found on wsmain.

Using DestLastRow instead of i for your output row on wsmacro will give you issues as well because it’s only calculated once (you don’t have it within a loop) which is why the data is overwritten.

You’ve got 3 different sheets you’re travelling down, so you need 3 different indices.

Also, wsmacro and destsht refer to the same worksheet. You don’t need both.

With all that said, here is my untested proposal:

Public Sub MainFileData2()

Dim iDest As Long, iMain As Long, iRef As Long
Dim MainLastRow As Long, RefLastRow As Long

Dim wbMacro As Workbook
Dim wbMain As Workbook

Set wbMacro = Workbooks.Item("MacroFile.xlsm")
Set wbMain = Workbooks.Item("SourceFile.csv")

Dim wsMacro As Worksheet
Dim wsMain As Worksheet
Dim wsRef As Worksheet

Set wsMain = wbMain.Worksheets.Item("SourceFileData")
Set wsRef = wbMacro.Worksheets.Item("Sheet1")
Set wsMacro = wbMacro.Worksheets("Data")

iMacro = 1   'Index for the destination sheet

MainLastRow = wsMain.Cells(wsMain.Rows.Count, 1).End(xlUp).Row
RefLastRow = wsRef.Cells(wsRef.Rows.Count, 1).End(xlUp).Row

Application.ScreenUpdating = False


For iMain = 2 To MainLastRow    'Go through each row of wsMain
    For iRef = 2 To RefLastRow  'For each row in the Main sheet, go through each row of the reference sheet
        If wsMain.Cells(iMain, 1) = wsRef.Cells(iRef, 1) Then

            wsMacro.Range("candnum").Offset(iMacro, 0) = wsMain.Cells(iMain, "B")
            wsMacro.Range("candname").Offset(iMacro, 0) = wsMain.Cells(iMain, "C")
            wsMacro.Range("estat").Offset(iMacro, 0) = wsMain.Cells(iMain, "E")
            wsMacro.Range("ira").Offset(iMacro, 0) = wsMain.Cells(iMain, "G")
            wsMacro.Range("wrkflw").Offset(iMacro, 0) = wsMain.Cells(iMain, "K")
            wsMacro.Range("fln").Offset(iMacro, 0) = wsMain.Cells(iMain, "O")
            wsMacro.Range("city").Offset(iMacro, 0) = wsMain.Cells(iMain, "R")
            wsMacro.Range("country").Offset(iMacro, 0) = wsMain.Cells(iMain, "S")

            iMacro = iMacro + 1 'Ensures the next output to wsMacro will go in the next row

            Exit For 'The match has been found, so you can move on to the next row in wsMain without checking the rest of the rows in wsRef
        End If
    Next iRef
Next iMain

Application.ScreenUpdating = True

End Sub

Answer:

Your code should really be structured more like this – use i only as the destination row counter, incrementing it only when you’ve added a line. Your For each cell in engrange will go through every cell in Range("B2:B500000") – don’t try to use engrangeagain in your loop when you’ve already defined it as the range you’re iterating through.

Although, I can only do so much here because I have no idea what those named ranges refer to – IMO, I’d get rid of the named ranges altogether.

Option Explicit
Public Sub MainFileData2()

Dim i As Long, k As Long

Dim wbmacro As Workbook
Dim wbmain As Workbook

Set wbmacro = Workbooks.Item("MacroFile.xlsm")
Set wbmain = Workbooks.Item("SourceFile.csv")

Dim wsmacro As Worksheet
Dim wsmain As Worksheet
Dim wsref As Worksheet

Set wsmacro = wbmacro.Worksheets.Item("Data")
Set wsmain = wbmain.Worksheets.Item("SourceFileData")
Set wsref = wbmacro.Worksheets.Item("Sheet1")

Dim engrange As Range
Set engrange = wsmain.Range("B2:B500000")

Dim cell As Range

k = 1
i = 2

Application.ScreenUpdating = False

For Each cell In engrange

    If cell.Value = wsref.Cells(k, 1).Value Then

        wsmacro.Cells(i, 1).Value = cell.Offset(, 1).Value
        wsmacro.Cells(i, 2).Value = cell.Offset(, 2).Value
        wsmacro.Cells(i, 3).Value = cell.Offset(, 3).Value
        wsmacro.Cells(i, 4).Value = cell.Offset(, 4).Value
        wsmacro.Cells(i, 5).Value = cell.Offset(, 5).Value
        wsmacro.Cells(i, 6).Value = cell.Offset(, 6).Value
        wsmacro.Cells(i, 7).Value = cell.Offset(, 7).Value
        wsmacro.Cells(i, 8).Value = cell.Offset(, 8).Value

        i = i + 1

    End If

Next cell

Application.ScreenUpdating = True

End Sub

Answer:

A few things that might help

  1. I would recommend changing engrange to a Long datatype and Set engrange = wsmain.Range("B2:B500000") to engrange = wsmain.Range("B" & Rows.Count).End(xlUp).Row that way you can utilize a For Loop and you don’t have to manually increment i every iteration.
  2. I would try using an output range that is offset every iteration where your If statement evaluates to True. Right now it’s just taking the i value and placing it there because you’re increasing it every iteration.
  3. It looks like you’re trying to match a value. Instead of looping through the entire sheet for every value looking for a match, why not use .Find?

I would write it like this

Public Sub MainFileData2()

Dim i As Long, k As Long

Dim wbmacro As Workbook
Dim wbmain As Workbook

Set wbmacro = Workbooks.Item("MacroFile.xlsm")
Set wbmain = Workbooks.Item("SourceFile.csv")

Dim wsmacro As Worksheet
Dim wsmain As Worksheet
Dim wsref As Worksheet

Set wsmacro = wbmacro.Worksheets.Item("Data")
Set wsmain = wbmain.Worksheets.Item("SourceFileData")
Set wsref = wbmacro.Worksheets.Item("Sheet1")
Set destsht = Workbooks("MacroFile.xlsm").Worksheets("Data")

Dim engrange As Long
engrange = wsmain.Range("B" & Rows.Count).End(xlUp).Row

Dim fRng as Range

Dim outRng as Range
Set outRng = wsmacro.Range("A2")    

Application.ScreenUpdating = False

For i = 2 to engrange

    Set fRng = wsref.Range("A:A").Find(wsmain.Cells(i, 2),,xlValues,xlWhole)

    If not fRng Is Nothing Then

        outRng.Offset(0, 0) = wsmain.Range("B" & i)
        outRng.Offset(0, 1) = wsmain.Range("C" & i)
        outRng.Offset(0, 2) = wsmain.Range("E" & i)
        outRng.Offset(0, 3) = wsmain.Range("G" & i)
        outRng.Offset(0, 4) = wsmain.Range("K" & i)
        outRng.Offset(0, 5) = wsmain.Range("O" & i)
        outRng.Offset(0, 6) = wsmain.Range("R" & i)
        outRng.Offset(0, 7) = wsmain.Range("S" & i)

        Set outRng = outRng.Offset(1, 0)

    End If

Next i

Application.ScreenUpdating = True


End Sub

A find function will perform alot faster than searching every cell for a match, and using the Range("B" & Rows.Count).End(xlUp).Row method will ensure you’re never searching blank rows.