# Conditionally copying cells from other worksheets

I wrote super redundant VBA code and it works and solve my problem. I am trying to simplify it but don't know where to start due to my limited knowledge in VBA.

Basically, this code works as a vlookup function and return all required data from other sheets in the same workbook. I have multiple columns to be filled so I repeat using the same codes. But I believe there is a much more neat version rather than mine.

Sub LoopTem()

Dim ws As Worksheet
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet
Dim ws4 As Worksheet
Dim ws5 As Worksheet
Dim ws6 As Worksheet
Dim ws7 As Worksheet

Dim i As Integer
Dim r As Integer
Dim s As Integer
Dim t As Integer
Dim u As Integer
Dim v As Integer
Dim w As Integer

Dim lastRow As Integer
Dim lastRow2 As Integer
Dim lastRow3 As Integer
Dim lastRow4 As Integer
Dim lastRow5 As Integer
Dim lastRow6 As Integer
Dim lastRow7 As Integer

Set ws = Worksheets("Proactive Template")
Set ws2 = Worksheets("To")
Set ws3 = Worksheets("Copy")
Set ws4 = Worksheets("Comment")
Set ws5 = Worksheets("PAM Consolidation")
Set ws6 = Worksheets("PSS Contact")
Set ws7 = Worksheets("Mapping")

lastRow = ws.Range("Q" & Rows.Count).End(xlUp).Row
lastRow2 = ws2.Range("Q" & Rows.Count).End(xlUp).Row
lastRow3 = ws3.Range("Q" & Rows.Count).End(xlUp).Row
lastRow4 = ws4.Range("A" & Rows.Count).End(xlUp).Row
lastRow5 = ws5.Range("A" & Rows.Count).End(xlUp).Row
lastRow6 = ws6.Range("A" & Rows.Count).End(xlUp).Row
lastRow7 = ws7.Range("L" & Rows.Count).End(xlUp).Row

For i = 2 To lastRow
For r = 2 To lastRow2
If ws.Cells(i, 18) = ws2.Cells(r, 17) Then
ws.Cells(i, 20) = ws2.Cells(r, 19)
Exit For
End If
Next r
Next i

For i = 2 To lastRow
For s = 2 To lastRow3

If ws.Cells(i, 18) = ws3.Cells(s, 17) Then
ws.Cells(i, 21) = ws3.Cells(s, 19)
Exit For
End If
Next s
Next i

For i = 2 To lastRow
For t = 2 To lastRow4
If ws.Cells(i, 14) = ws4.Cells(t, 1) Then
ws.Cells(i, 19) = ws4.Cells(t, 2)
Exit For
End If
Next t
Next i

For i = 2 To lastRow
For u = 2 To lastRow5
If ws.Cells(i, 11) = ws5.Cells(u, 1) Then
ws.Cells(i, 22) = ws5.Cells(u, 2)
Exit For
End If
Next u
Next i

For i = 2 To lastRow
For v = 2 To lastRow6
If ws.Cells(i, 11) = ws6.Cells(v, 1) Then
ws.Cells(i, 23) = ws6.Cells(v, 3)
ws.Cells(i, 24) = ws6.Cells(v, 2)
ws.Cells(i, 25) = ws6.Cells(v, 4)

Exit For
End If
Next v
Next i

For i = 2 To lastRow
For w = 2 To lastRow6
If ws.Cells(i, 10) = ws7.Cells(w, 12) Then
ws.Cells(i, 26) = ws7.Cells(w, 13)
Exit For
End If
Next w
Next i

ws.Cells.WrapText = False

End Sub

• I did used it to locate the worksheet for lastrow and in loop Nov 28 '14 at 2:09

## 1 Answer

There are two different ways you could go about DRYing this up.

## 1) Create a subroutine that takes some parameters.

I want to show you this first, because it's very important to learn this concept. Anytime you see patterns like below, you should be extracting out new subroutines or functions.

For i = 2 To lastRow
For r = 2 To lastRow2
If ws.Cells(i, 18) = ws2.Cells(r, 17) Then
ws.Cells(i, 20) = ws2.Cells(r, 19)
Exit For
End If
Next r
Next i

For i = 2 To lastRow
For s = 2 To lastRow3

If ws.Cells(i, 18) = ws3.Cells(s, 17) Then
ws.Cells(i, 21) = ws3.Cells(s, 19)
Exit For
End If
Next s


If you look carefully at this, you'll notice that the only difference between these loops is the source column, the destination sheet, and the destination column.

Sub CopyData(souceWs As Worksheet, sourceCol As Long, destWs as Worksheet, destCol As Long)
Dim lastRow As Long, destLastRow As Long
lastRow = sourceWs.Range("Q" & Rows.Count).End(xlUp).Row
destLastRow = destWs.Range("Q" & Rows.Count).End(xlUp).Row

Dim i As Long, j As Long
For i = 2 To lastRow
For j = 2 To destLastRow
If destWs.Cells(i, 18) = sourceWs.Cells(r, 17) Then
destWs.Cells(i, destCol) = sourceWs.Cells(r, sourceCol)
Exit For
End If
Next j
Next i
End Sub


And then call this subroutine from your main routine once for each sheet that needs to be processed.

CopyData Worksheets("To"), 19, ws, 20
CopyData Worksheets("Copy"), 19, ws, 21
'etc


However, this would be terribly slow if there is a large amount of data to process. It would loop through the entire destination once for every call to CopyData.

## 2) Move everything inside of the outer loop.

There's no sense in looping from 2 To destLastRow over and over again. The code gets DRYed up a good bit and sees a performance boost by moving the logic inside.

For i = 2 To destLastRow

sourceWs = Worksheets("To")
lastRow = sourceWs.Range("Q" & Rows.Count).End(xlUp).Row

For j = lastRow
'do stuff
Next j

sourceWs = Worksheets("Blah")
lastRow = sourceWs.Range("Q" & Rows.Count).End(xlUp).Row

For j = lastRow
'do stuff
Next j

'etc

Next i


At this point there's still some duplication, so you could use the concepts from #1 to extract the inner loop to its own subroutine.

## Some other things you could do better:

• The inside of each For block should be one indentation level (1 tab or four spaces) deeper. It's easier to follow.

• I know a lot of people innocently recommend not reusing variable names, but sometimes it's cleaner to do so. Your inner loop counter was way up past r in the alphabet. Note how I reused j above once I was done with the previous loop. It just makes for less to remember. Just make sure that you're actually done with these generic variables before reusing them.

• Don't number variables. If you catch yourself numbering variables, do exactly what you did =;)- Stop and look for a way to clean it up with a loop, subroutine, function, etc. If you just can't avoid it, give them meaningful names like sourceSheet and destSheet.

• Thank you so much RubberDuck for your patience and advice. That helps me a lot. Nov 27 '14 at 2:44
• You're very welcome! Thank you for the good question! Welcome to CR. Come back anytime. =) Nov 27 '14 at 2:52