Group sheets without defined array?

sweeneytime

Board Regular
Joined
Aug 23, 2010
Messages
183
Hi all,

Trying to group sheets with a macro.

I was using an array with the sheet names defined. But I want the code to be able to select new sheets if added. Selecting sheets based on data in "A5".

I adapted code that looped and selected sheets correctly. But it won't group, just selects each sheet individually and moves on.

Any suggestions?

Thanks,
Alan

PHP:
Sub SelectCC()
    Dim ws As Worksheet
    
    'Select sheets with "INCOME" in A5
    'Should only be the Cost Centres
    For Each ws In ActiveWorkbook.Worksheets
            If ws.Range("A5").Text = ("INCOME") Then
                ws.Select
            End If
    Next ws
    

End Sub
 

Excel Facts

Which came first: VisiCalc or Lotus 1-2-3?
Dan Bricklin and Bob Frankston debuted VisiCalc in 1979 as a Visible Calculator. Lotus 1-2-3 debuted in the early 1980's, from Mitch Kapor.
I don't get it. If you have a single sheet name in cell A5, what other sheet are you expecting to have selected than the single sheet name that is the text item in cell A5?
 
Upvote 0
Tom thanks for the response.

I have have about 30 sheets which are cost centres. Named 010,020,030 etc. Then there are other check and total sheets.

I only wish to group the cost centres. The cost centres have "INCOME" written in A5 the other total sheets do not.

I am new to VBA and it seemed like an easy way in VBA to identify sheets between cost centres and non-cost centre sheets.
 
Upvote 0
I think you only need a few small changes to your existing code.
Rich (BB code):
Sub SelectCC()
    Dim ws As Worksheet
    Dim bStarted As Boolean
    
    'Select sheets with "INCOME" in A5
    'Should only be the Cost Centres
    For Each ws In ActiveWorkbook.Worksheets
            If ws.Range("A5").Text = ("INCOME") Then
                ws.Select Replace:=Not bStarted
                bStarted = True
            End If
    Next ws
End Sub
 
Upvote 0
I think you only need a few small changes to your existing code.
Rich (BB code):
Sub SelectCC()
    Dim ws As Worksheet
    Dim bStarted As Boolean
 
    'Select sheets with "INCOME" in A5
    'Should only be the Cost Centres
    For Each ws In ActiveWorkbook.Worksheets
            If ws.Range("A5").Text = ("INCOME") Then
                ws.Select Replace:=Not bStarted
                bStarted = True
            End If
    Next ws
End Sub

Hi Peter,

would you explain how it works, Please

ws.Select Replace:=Not bStarted
 
Upvote 0
Hi Peter,

would you explain how it works, Please

ws.Select Replace:=Not bStarted
I'll try.

The Replace parameter is Boolean (True or False) with the default being True.
It determines whether to replace the existing sheet selection (if True) or not (if False). If not, then it adds to the existing selection.

The problem was, by omitting the parameter it was using the default value of True and so every time you came to a new sheet that met your criteria, the sheet was selected but the previous one was de-selected.

When I Dim the boolean bStarted, it takes the default value of False. So the first sheet I come to that meets the criteria
Replace:=Not bStarted is really
Replace:=Not False
Replace:=True

This ensures that if your code starts on a sheet that does not meet your criteria, it will be de-selected. If you do start on a sheet that meets your criteria it will also be de-selected but it replaced in the selection by itself - so no problem.

Having done this first sheet, I set bStarted to True so that from then on
Replace:=Not bStarted
Replace:=Not True
Replace:=False

so the sheet selection just gets added to.

Hope that made some sense. :)
 
Upvote 0
Perhaps something like this, which puts "AAAA" in A1 of the indicated sheets.
Selection may not be needed.
Code:
Sub Macro1()
    Dim namesArray() As Variant
    Dim oneSheet As Worksheet
    Dim Pointer As Long
    
    ReDim namesArray(0 To ThisWorkbook.Sheets.Count)
    
    For Each oneSheet In ThisWorkbook.Worksheets
        With oneSheet
            If LCase(CStr(.Range("A5").Value)) = "income" Then
                namesArray(Pointer) = .Name
                Pointer = Pointer + 1
            End If
        End With
    Next oneSheet
    
    If Pointer = 0 Then
        Rem noneFound
        MsgBox "No sheet says Income"
    Else
        Pointer = Pointer - 1
        ReDim Preserve namesArray(0 To Pointer)
        
        With Sheets(namesArray)
            .Item(Pointer).Range("A1") = "AAAA"
            .FillAcrossSheets Range:=.Item(Pointer).Range("A1"), Type:=xlFillWithAll
        End With
        
    End If
End Sub
 
Last edited:
Upvote 0

Forum statistics

Threads
1,213,489
Messages
6,113,952
Members
448,535
Latest member
alrossman

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top