patternModerate
Optimize total code in one sub
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 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
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
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
There are a few small changes to the routine to actually make this work. First, we need to replace any instances of
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
Your code now looks like this.
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.
-
This does not do what you think it does.
The only variable declared as an
Declarations can be inlined like this, but you must declare a type for each variable. Like this:
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 SubNote 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 SubAt 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 >> valuesYour 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 SubIt'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 thatlastRowandlastColwere not declared.
-
This does not do what you think it does.
Dim colCounter, rowCounter, col, row As IntegerThe 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 Integersheet.Activatedoe
Code Snippets
Public Sub Main()
Dim sheet As Worksheet
For Each sheet In Worksheets
SetValues sheet
Next sheet
End SubPrivate 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 Subabc_xnt >> rowCounter
abc_cnt >> columnCounter
abc_r >> row
abc_c >> col
abc_lrow >> lastRow
abc_lcol >> lastCol
abc_Arr >> valuesPrivate 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 SubContext
StackExchange Code Review Q#59323, answer score: 14
Revisions (0)
No revisions yet.