I have written some code to extract a list of worksheets in the ActiveWorkbook, but only for sheets that have a numeric name.
This works, but I would like to know the Code Review community's thoughts on my methods used here.
Public Sub listNumberedSheets()
Dim sheetNumberArray As Variant
ReDim sheetNumberArray(0)
Dim x As Long
x = 0
Sheets(1).Columns(1).ClearContents
Dim sht As Worksheet
For Each sht In ActiveWorkbook.Sheets
If IsNumeric(sht.Name) Then
ReDim Preserve sheetNumberArray(x)
sheetNumberArray(x) = sht.Name
x = x + 1
End If
Next
Sheets(1).Cells(1, 1).Resize(x, 1).Value = Application.Transpose(sheetNumberArray)
End Sub
1 Answer 1
Sheets(1).Columns(1).ClearContents
It's not a big deal in this case since the macro is always meant to work with the active workbook, but generally you want to preface a "Sheets" reference with an explicit reference to the workbook.
It's also generally not a good idea to refer to sheets by number. Using sheet names tends to be easier to read/debug.
My recommendation would be to add some parameters to the macro so that you can explicitly specify both a) the workbook whose sheets' names you want to check, and b) the worksheet on which to print the results. You can make the parameters optional if you'd like, and set them to "ActiveWorkbook" and "ActiveWorkbook.Sheets(1)" if they're missing from the call.
Application.Transpose(sheetNumberArray)
Once again, this isn't a huge deal in this particular macro, but Application.Transpose has some significant limitations (it doesn't work with very large arrays) and should be avoided if possible. In your case, since you're eventually just writing the results of your routine to the worksheet, ideally you'd just make your array two-dimensional:
ReDim resultsArr(1 To wb.Sheets.Count, 1 To 1) As Double
But currently that won't work because you're using...
ReDim Preserve sheetNumberArray(x)
Which brings me to my final recommendation: ReDim Preserve has high performance costs, and should be avoided if possible (especially uses like this in which it's called repeatedly). In your case, it's pretty easy to avoid, as you should be able to see in my revised code below.
Sub exampleMacro()
'Checks sheets in specified workbook, prints to specified worksheet
Call listNumberedSheets(ThisWorkbook, ThisWorkbook.Sheets("Results"))
'Checks sheets in active wb, prints to Sheets(1) of active wb
Call listNumberedSheets
End Sub
Sub listNumberedSheets(Optional wbToCheck As Workbook = Nothing, Optional resultsWS As Worksheet = Nothing)
If wbToCheck Is Nothing Then
Set wbToCheck = ActiveWorkbook
End If
If resultsWS Is Nothing Then
Set resultsWS = ActiveWorkbook.Sheets(1)
End If
ReDim resultsArr(1 To wbToCheck.Sheets.Count, 1 To 1) As Double
Dim i As Long
Dim j As Long
j = 1
For i = 1 To wbToCheck.Sheets.Count
Dim shtName As String
shtName = wbToCheck.Sheets(i).Name
If IsNumeric(shtName) Then
resultsArr(j, 1) = shtName
j = j + 1
End If
Next
With resultsWS
.Columns(1).ClearContents
If j > 1 Then
.Range(.Cells(1, 1), .Cells(j - 1, 1)).Value = resultsArr
End If
End With
End Sub
For maximum flexibility/reusability, I'd probably make it a function instead of a sub. That way it can either write the results to a worksheet OR return the results as an array. I'd also probably change it so that it could check multiple workbooks simultaneously. That definitely complicates the code a bit, but potentially makes it useful in more situations.
Sub exampleMacro()
'Checks sheets in specified workbooks, prints to specified worksheet
Call listNumberedSheets(Array(ThisWorkbook, Workbooks("Example workbook.xlsx")), ThisWorkbook.Sheets("Results"))
'Checks sheets in specified workbook, returns 1d array
Dim arr As Variant
arr = listNumberedSheets(ThisWorkbook)
End Sub
Function listNumberedSheets(wbToCheck As Variant, Optional resultsWS As Variant) As Variant
Dim wbArr As Variant
If Not IsArray(wbToCheck) Then
wbArr = Array(wbToCheck)
Else
wbArr = wbToCheck
End If
Dim sheetCount As Long
Dim i As Long
For i = LBound(wbArr) To UBound(wbArr)
If Not TypeName(wbArr(i)) = "Workbook" Then
MsgBox "Error: wbToCheck must be either workbook or array of workbooks"
Stop
Exit Function
Else
sheetCount = sheetCount + wbArr(i).Sheets.Count
End If
Next
ReDim resultsArr(1 To sheetCount, 1 To 1) As Double
Dim j As Long
Dim counter As Long
counter = 1
For i = LBound(wbArr) To UBound(wbArr)
For j = 1 To wbArr(i).Sheets.Count
Dim shtName As String
shtName = wbArr(i).Sheets(j).Name
If IsNumeric(shtName) Then
resultsArr(counter, 1) = shtName
counter = counter + 1
End If
Next
Next
If IsMissing(resultsWS) Then
If j = 1 Then
listNumberedSheets = ""
Else
ReDim finalArr(1 To counter - 1) As Double
For i = LBound(finalArr) To UBound(finalArr)
finalArr(i) = resultsArr(i, 1)
Next
listNumberedSheets = finalArr
End If
ElseIf TypeName(resultsWS) = "Worksheet" Then
If j > 1 Then
With resultsWS
.Columns(1).ClearContents
.Range(.Cells(1, 1), .Cells(counter - 1, 1)).Value = resultsArr
End With
End If
End If
End Function