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.
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 engrange
again 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
- I would recommend changing
engrange
to aLong
datatype andSet engrange = wsmain.Range("B2:B500000")
toengrange = wsmain.Range("B" & Rows.Count).End(xlUp).Row
that way you can utilize aFor Loop
and you don’t have to manually increment i every iteration. - I would try using an output range that is offset every iteration where your
If
statement evaluates toTrue
. Right now it’s just taking thei
value and placing it there because you’re increasing it every iteration. - 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.
Tags: excelexcel, vba