Adding to an array with select case - vba

Question

Hope someone can help with a puzzling problem.
I have an excel worksheet that has a lot of lines that need to be moved to different sheets.
I have a select case statement that sets 3 variables to true or false depending on whether the numbers in the first column match a case statement. This works ok but I now want to add a name to an array if the value is true.
The select case statement is as follows :
While LContinue
If LRow = Lastrow Then
LContinue = False
Else
Select Case Range("A" & LRow).Value
Case 30 To 39
MainSheet = True
'Tabs(0) = "Main"
Case 40 To 49
SecondSheet = True
'Tabs(1) = "Second"
Case 111 To 112
ThirdSheet = True
'Tabs(2) = "Third"
End Select
LRow = LRow + 1
End If
Wend
This is used to see if I need to add the sheet or not. to add the sheets I use the following code :
For i = LBound(Tabs) To UBound(Tabs)
Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = Tabs(i)
Next i
So what I would like to know is how would I go about adding the sheetnames to the array but only if the value in the select case is true.
Any help would be much appreciated.
Thanks

Answer 1

Why not use worksheet function 'CountIfs'?
It counts on multiple criteria and you do not need any loops so your code will run quicker.
CountIfs(testedRange, ">=30", testedRange, "<=39")
... calculates number of values in 'testedRange' which are >=30 and <=39. If there is at least one then just add your sheet, that's it. No loops, no arrays, no additional variables needed. HTH.
Public Sub test()
Dim testedRange As Range
Dim Lastrow As Long
Lastrow = 10
Set testedRange = ActiveSheet.Range("A1:A" & Lastrow)
With Application.WorksheetFunction
If .CountIfs(testedRange, ">=30", testedRange, "<=39") > 0 Then
ThisWorkbook.Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Main"
End If
If .CountIfs(testedRange, ">=40", testedRange, "<=49") > 0 Then
ThisWorkbook.Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Second"
End If
If .CountIfs(testedRange, ">=111", testedRange, "<=112") > 0 Then
ThisWorkbook.Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Third"
End If
End With
End Sub

Answer 2

Excel VBA is not very flexible when it come to working with actual arrays. But you can work with a collection instead:
SET tabs = new Collection
And then you can add a new value to it whenever you need to (e.g. in the CASE structure):
.
..
...
Case 40 To 49
SecondSheet = True
Tabs.add "Second"
...
..
The values of the collection can be accessed almost in the same way as those of an array:
for j=1 to tabs.count
Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = tabs(j)
next j
Edit:
Since the code is re-entrant, i.e. there can be several instances when Range("A" & LRow).Value will be evaluated, we must make sure, that an item is set only once. This can be done easiest with a dictionary (instead of a collection):
Set tabs = CreateObject("Scripting.Dictionary")
Now it is easy to establish, whether a particular page has already been defined before:
..
...
Case 40 To 49
SecondSheet = True
tabs("Second")=1
The page creation loop then looks like this
for each k in tabs.keys
Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = k
next k
The loop iterates over the keys only. There is no need to check for duplicate entries as all unique keys will be defined and listed only once!

Answer 3

To do this with an array you would want to:
declare a dynamic array of strings
declare a counter for the number of elements added
set the array's size to the largest value that it could possibly be
assign elements to the array, incrementing the counter for each addition
resize the array using the counter value (or test for empty elements when accessing array)
In code that could translate into something like:
Dim Tabs() as String
Dim counter As Long
...
Redim Tabs(0 to Lastrow)
counter = 0
...
While ...
Select Case .Range("A" & lrow).Value
Case 30 To 39
Mainsheet = True
Tabs(count) = "Main"
...
Case Else
counter = counter - 1
End Select
counter = counter + 1
...
Wend
If Not counter = 0 Then
Redim Preserve Tab(0 to counter - 1)
...
'create worksheets using Tabs(), etc.
...
End If