patternMinor
Conditionally copying cells from other worksheets
Viewed 0 times
conditionallyothercellscopyingworksheetsfrom
Problem
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
`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
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
Solution
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.
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.
And then call this subroutine from your main routine once for each sheet that needs to be processed.
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
2) Move everything inside of the outer loop.
There's no sense in looping from
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
-
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
-
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
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 sIf 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 SubAnd 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
'etcHowever, 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 iAt 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.Code Snippets
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 sSub 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 SubCopyData Worksheets("To"), 19, ws, 20
CopyData Worksheets("Copy"), 19, ws, 21
'etcFor 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 iContext
StackExchange Code Review Q#70898, answer score: 3
Revisions (0)
No revisions yet.