HiveBrain v1.2.0
Get Started
← Back to all entries
patternModerate

Optimize total code in one sub

Submitted by: @import:stackexchange-codereview··
0
Viewed 0 times
totalsuboneoptimizecode

Problem

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

Solution

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.

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 doe

Code Snippets

Public Sub Main()
    Dim sheet As Worksheet
    For Each sheet In Worksheets
        SetValues sheet
    Next sheet
End Sub
Private Sub SetValues(sheet As Worksheet)
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
abc_xnt >> rowCounter
abc_cnt >> columnCounter
abc_r >> row
abc_c >> col
abc_lrow >> lastRow
abc_lcol >> lastCol
abc_Arr >> values
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

Context

StackExchange Code Review Q#59323, answer score: 14

Revisions (0)

No revisions yet.