# Optimize total code in one sub

I have the following code which works fine, but there has to be a faster way to do this. I want to have it all in one sub.

Sub abc_slbstd()

Dim abc_cnt, abc_xnt, abc_c, abc_r As Integer
abc_xnt = 1
abc_cnt = 0
abc_r = 1
abc_c = 1
Dim abcArr() As Variant
Worksheets("abc").Activate

abc_lrow = Worksheets("totallist").Cells.SpecialCells(xlCellTypeLastCell).Row
abc_lcol = Worksheets("totallist").Cells(1, Columns.Count).End(xlToLeft).Column

With Sheets("totallist")
End With

For abc_r = 1 To UBound(abcArr, 1) ' First array dimension is rows.
For abc_c = 1 To UBound(abcArr, 2) ' Second array dimension is columns.
If Worksheets("totallist").Cells(abc_r, 9).Value = "abc" Then
abc_cnt = abc_cnt + 1

If abc_cnt = 10 Then
abc_xnt = abc_xnt + 1
abc_cnt = 1
End If

Worksheets("abc").Cells(abc_xnt, abc_cnt).Value = abcArr(abc_r, abc_c)

End If
Next abc_c
Next abc_r

Call def_slbstd
End Sub


Sub def_slbstd()
Dim def_cnt, def_xnt, def_c, def_r As Integer
def_xnt = 1
def_cnt = 0
def_r = 1
def_c = 1
Dim defArr() As Variant
Worksheets("def").Activate

def_lrow = Worksheets("totallist").Cells.SpecialCells(xlCellTypeLastCell).Row
def_lcol = Worksheets("totallist").Cells(1, Columns.Count).End(xlToLeft).Column

With Sheets("totallist")
End With

For def_r = 1 To UBound(defArr, 1) ' First array dimension is rows.
For def_c = 1 To UBound(defArr, 2) ' Second array dimension is columns.
If Worksheets("totallist").Cells(def_r, 9).Value = "def" Then

def_cnt = def_cnt + 1
If def_cnt = 10 Then
def_xnt = def_xnt + 1
def_cnt = 1
End If
Worksheets("def").Cells(def_xnt, def_cnt).Value = defArr(def_r, def_c)

End If

Next def_c
Next def_r
Call ghi_slbstd
End Sub


Sub ghi_slbstd()
Dim ghi_cnt, ghi_xnt, ghi_c, ghi_r As Integer
ghi_xnt = 1
ghi_cnt = 0
ghi_r = 1
ghi_c = 1
Dim ghiArr() As Variant
Worksheets("ghi").Activate

ghi_lrow = Worksheets("totallist").Cells.SpecialCells(xlCellTypeLastCell).Row
ghi_lcol = Worksheets("totallist").Cells(1, Columns.Count).End(xlToLeft).Column

With Sheets("totallist")
End With

For ghi_r = 1 To UBound(ghiArr, 1) ' First array dimension is rows.
For ghi_c = 1 To UBound(ghiArr, 2) ' Second array dimension is columns.
If Worksheets("totallist").Cells(ghi_r, 9).Value = "ghi" Then

ghi_cnt = ghi_cnt + 1
If ghi_cnt = 10 Then
ghi_xnt = ghi_xnt + 1
ghi_cnt = 1
End If
Worksheets("ghi").Cells(ghi_xnt, ghi_cnt).Value = ghiArr(ghi_r, ghi_c)

End If

Next ghi_c
Next ghi_r
Call klm_slbstd

End Sub


Sub klm_slbstd()
Dim klm_cnt, klm_xnt, klm_c, klm_r As Integer
klm_xnt = 1
klm_cnt = 0
klm_r = 1
klm_c = 1
Dim klmArr() As Variant
Worksheets("klm").Activate

klm_lrow = Worksheets("totallist").Cells.SpecialCells(xlCellTypeLastCell).Row
klm_lcol = Worksheets("totallist").Cells(1, Columns.Count).End(xlToLeft).Column

With Sheets("totallist")
End With

For klm_r = 1 To UBound(klmArr, 1) ' First array dimension is rows.
For klm_c = 1 To UBound(klmArr, 2) ' Second array dimension is columns.
If Worksheets("totallist").Cells(klm_r, 9).Value = "klm" Then

klm_cnt = klm_cnt + 1
If klm_cnt = 10 Then
klm_xnt = klm_xnt + 1
klm_cnt = 1
End If
Worksheets("klm").Cells(klm_xnt, klm_cnt).Value = klmArr(klm_r, klm_c)

End If

Next klm_c
Next klm_r
Call nop_slbstd
End Sub


Sub nop_slbstd()
Dim nop_cnt, nop_xnt, nop_c, nop_r As Integer
nop_xnt = 1
nop_cnt = 0
nop_r = 1
nop_c = 1
Dim nopArr() As Variant
Worksheets("nop").Activate

nop_lrow = Worksheets("totallist").Cells.SpecialCells(xlCellTypeLastCell).Row
nop_lcol = Worksheets("totallist").Cells(1, Columns.Count).End(xlToLeft).Column

With Sheets("totallist")
End With

For nop_r = 1 To UBound(nopArr, 1) ' First array dimension is rows.
For nop_c = 1 To UBound(nopArr, 2) ' Second array dimension is columns.
If Worksheets("totallist").Cells(nop_r, 9).Value = "nop" Then

nop_cnt = nop_cnt + 1
If nop_cnt = 10 Then
nop_xnt = nop_xnt + 1
nop_cnt = 1
End If
Worksheets("nop").Cells(nop_xnt, nop_cnt).Value = nopArr(nop_r, nop_c)

End If

Next nop_c
Next nop_r
Call drs_slbstd
End Sub


Only the first three letters and the worksheet name change. Can this be written short in one sub, or shall I continue ctrl-c and ctrl-v? I need it 26 times, so it will take a time

-

## migrated from stackoverflow.comAug 7 '14 at 1:55

This question came from our site for professional and enthusiast programmers.

Based solely on your Worksheets("abc").Activate line it seems you are using multiple sheets in a workbook. To point you in a, hopefully helpful, direction for something like this I would wrap the entire sub in a FOR EACH worksheet IN workbook your code here NEXT worksheet statement. Then within the loop you can set variables that reference whatever sheet it's currently in. EDIT: Also, @ckuhn203 makes a good point, Code Review is very helpful for this sort of question. –  UserUnknown Aug 6 '14 at 22:59

I think you've missed the point of having subroutines. The idea is to reduce the problem into small simple steps. Each step of the problem is translated into a subroutine (or a function).

Let's start at 30,000 feet in the air. What you want to do is perform an action on a number of worksheets. I'm assuming that you want to work on every sheet in a given workbook. What we'll do is iterate over the Worksheets collection and change your sub so that it takes in a worksheet as a parameter.

Public Sub Main()
Dim sheet As Worksheet
For Each sheet In Worksheets
SetValues sheet
Next sheet
End Sub


Note that at this point I have not changed any of the code in question. All I've done is define a way to perform an action on each sheet in the active workbook. I did replace the subroutine name slbstd with something a little more meaningful and passed it a worksheet to work on. So, your sub declaration will now look like this.

Private Sub SetValues(sheet As Worksheet)


There are a few small changes to the routine to actually make this work. First, we need to replace any instances of Worksheets("abc") with the parameter sheet. Second, we need to replace "abc" with sheet.Name. The code now looks like this.

Private Sub SetValues(sheet As Worksheet)

Dim abc_cnt, abc_xnt, abc_c, abc_r As Integer
abc_xnt = 1
abc_cnt = 0
abc_r = 1
abc_c = 1
Dim abcArr() As Variant
sheet.Activate

abc_lrow = Worksheets("totallist").Cells.SpecialCells(xlCellTypeLastCell).Row
abc_lcol = Worksheets("totallist").Cells(1, Columns.Count).End(xlToLeft).Column

With Sheets("totallist")
End With

For abc_r = 1 To UBound(abcArr, 1) ' First array dimension is rows.
For abc_c = 1 To UBound(abcArr, 2) ' Second array dimension is columns.
If Worksheets("totallist").Cells(abc_r, 9).Value = sheet.Name Then
abc_cnt = abc_cnt + 1

If abc_cnt = 10 Then
abc_xnt = abc_xnt + 1
abc_cnt = 1
End If

sheet.Cells(abc_xnt, abc_cnt).Value = abcArr(abc_r, abc_c)

End If
Next abc_c
Next abc_r

End Sub


At this point, the problem you've asked about is solved, but I'm going to beg you to stay with me. We can make this better yet.

The naming is.... well.... it's bad. Part of the problem is that you've prefixed all of them with the name of the sheet you're working on. I have a feeling that you don't understand variable scope very well. I recommend reading up on it. There was never a need to do this, so let's get rid of all that.

It goes beyond the odd prefixes though. Once we've removed them, we're left with names like xnt, cnt, r, and c. These are cryptic. We have to map the meanings in our minds, and that makes programming that much more difficult to do. Say it in English whenever you can.

abc_xnt >> rowCounter
abc_cnt >> columnCounter
abc_r >> row
abc_c >> col
abc_lrow >> lastRow
abc_lcol >> lastCol
abc_Arr >> values


Your code now looks like this.

Private Sub SetValues(sheet As Worksheet)

Dim colCounter, rowCounter, col, row As Integer
rowCounter = 1
colCounter = 0
row = 1
col = 1
Dim values() As Variant
sheet.Activate

lastRow = Worksheets("totallist").Cells.SpecialCells(xlCellTypeLastCell).row
lastCol = Worksheets("totallist").Cells(1, Columns.Count).End(xlToLeft).Column

With Sheets("totallist")
End With

For row = 1 To UBound(values, 1) ' First array dimension is rows.
For col = 1 To UBound(values, 2) ' Second array dimension is columns.
If Worksheets("totallist").Cells(row, 9).Value = sheet.Name Then
colCounter = colCounter + 1

If colCounter = 10 Then
rowCounter = rowCounter + 1
colCounter = 1
End If

sheet.Cells(rowCounter, colCounter).Value = values(row, col)

End If
Next col
Next row

End Sub


It's 100% more readable and it's easier to pick out where improvements can be made. From here out, I'm going to take a line by line approach.

• Use Option Explicit. I have it turned on by default and it instantly alerted me to the fact that lastRow and lastCol were not declared.
• This does not do what you think it does.

Dim colCounter, rowCounter, col, row As Integer


The only variable declared as an Integer here is row. The rest are declared as Variant. This can be seen in the Locals Window.

Declarations can be inlined like this, but you must declare a type for each variable. Like this:

Dim colCounter As Integer, rowCounter As Integer
Dim col As Integer, row As Integer

• sheet.Activate does nothing useful for this subroutine. It can safely be removed.
• The method you're using to find the last cell might not be the best one. The UsedRange can produce odd results.
• .Cells(1, 1).Address is a really verbose way of saying "$A$1". Just use the string value.

With Sheets("totallist")
values = .Range("$A$1", .Cells(lastRow, lastCol).Address).Value
End With


Okay. I could probably pick at a few more things (like magic numbers and magic strings), but I've already thrown a wall of text at you. Thanks for sticking with me here. I hope you've read past the point where your problem was resolved.

Without further ado, the code as far as I took it:

Option Explicit

Public Sub Main()
Dim sheet As Worksheet
For Each sheet In Worksheets
SetValues sheet
Next sheet
End Sub

Private Sub SetValues(sheet As Worksheet)

Dim colCounter As Integer, rowCounter As Integer
Dim col As Integer, row As Integer

rowCounter = 1
colCounter = 0
row = 1
col = 1

Dim values() As Variant

Dim lastRow As Integer, lastCol As Integer
lastRow = Worksheets("totallist").Cells.SpecialCells(xlCellTypeLastCell).row
lastCol = Worksheets("totallist").Cells(1, Columns.Count).End(xlToLeft).Column

With Sheets("totallist")
values = .Range("$A$1", .Cells(lastRow, lastCol).Address).Value
End With

For row = 1 To UBound(values, 1) ' First array dimension is rows.
For col = 1 To UBound(values, 2) ' Second array dimension is columns.
If Worksheets("totallist").Cells(row, 9).Value = sheet.Name Then
colCounter = colCounter + 1

If colCounter = 10 Then
rowCounter = rowCounter + 1
colCounter = 1
End If

sheet.Cells(rowCounter, colCounter).Value = values(row, col)

End If
Next col
Next row

End Sub


Note: I did not implement a better lastRow or lastCol function.

-
Beautiful Code! as Beautiful as VB can be, LOL :) –  Lyle's Mug Aug 7 '14 at 13:05
Call SomeProcedure


That will work, and call a procedure named SomeProcedure. But you don't need to do that in - Call is a relic from an ancient version of the language, that was left there to maintain compatibility.

This is all you need to do, to call SomeProcedure:

SomeProcedure


No lies!

You're not consistent with the way you're referring to the sheet totallist.

Here with the Worksheets collection:

lastRow = Worksheets("totallist").Cells.SpecialCells(xlCellTypeLastCell).row


And here with the Sheets collection:

With Sheets("totallist")


The Sheets collection contains chart sheets if your workbook has sheets of that type; the Worksheets collection only contains, well, worksheets. Hence, you should be using the Worksheets collection when referring to worksheet objects, be it just because it's more precise/specific - it's really just a matter of readability, at the end of the day you're still fetching the exact same object. But being consistent about how you're doing it will help avoid mental question marks when you (or someone else?) look at your code 6 months down the line.

I don't like With blocks used like this:

With Sheets("totallist")
values = .Range("$A$1", .Cells(lastRow, lastCol).Address).Value
End With


Just a few lines below that, you're referring to the same worksheet, outside the With block. You could extend the block to encompass all references to it, but I find that's a lazy way of writing code, and it's also a bit of an abuse of the With keyword.

Or you could declare a Worksheet variable to hold the reference:

Dim totalSheet As Worksheet
Set totalSheet = Worksheets("totallist")


And then you can do:

values = totalSheet.Range("$A$1", totalSheet.Cells(lastRow, lastCol).Address).Value
...
If totalSheet.Cells(row, 9).Value = sheet.Name Then
...
...


The idea is to avoid referring to worksheets by their name ("magic strings") as much as possible, so if/when the sheet's name changes, maintenance is less of a pain easier, since there's fewer places to modify.

-
Thank you for mentioning the Call. I removed it without mentioning it in my answer. –  RubberDuck Aug 7 '14 at 10:33