Take the 2-minute tour ×
Code Review Stack Exchange is a question and answer site for peer programmer code reviews. It's 100% free, no registration required.

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")
    abcArr = .Range(.Cells(1, 1).Address, .Cells(abc_lrow, abc_lcol).Address).Value
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")
    defArr = .Range(.Cells(1, 1).Address, .Cells(def_lrow, def_lcol).Address).Value
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")
    ghiArr = .Range(.Cells(1, 1).Address, .Cells(ghi_lrow, ghi_lcol).Address).Value
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")
    klmArr = .Range(.Cells(1, 1).Address, .Cells(klm_lrow, klm_lcol).Address).Value
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")
    nopArr = .Range(.Cells(1, 1).Address, .Cells(nop_lrow, nop_lcol).Address).Value
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

share|improve this question

migrated from stackoverflow.com Aug 7 at 1:55

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

1  
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 at 22:59

2 Answers 2

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")
        abcArr = .Range(.Cells(1, 1).Address, .Cells(abc_lrow, abc_lcol).Address).Value
    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")
        values = .Range(.Cells(1, 1).Address, .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

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.

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.

share|improve this answer
2  
Beautiful Code! as Beautiful as VB can be, LOL :) –  Malachi Aug 7 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.

share|improve this answer
1  
Thank you for mentioning the Call. I removed it without mentioning it in my answer. –  RubberDuck Aug 7 at 10:33

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.