6
\$\begingroup\$

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
\$\endgroup\$
1
  • \$\begingroup\$ I did used it to locate the worksheet for lastrow and in loop \$\endgroup\$
    – AileenQ
    Nov 28 '14 at 2:09
3
\$\begingroup\$

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.

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

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.