Help with sheet names in an Array using VBA

Kayslover

Board Regular
Joined
Sep 22, 2020
Messages
138
Office Version
  1. 2013
Platform
  1. Windows
Hi all,

I use a Template to create 12 monthly workbooks.

Each workbook has 9-10 sheets with it.

The template runs macros to format each monthly file, namely:-
  • inserts dates in certain rows,
  • check how many weeks are in the month,
  • if there are only 4 weeks, delete sheet called Sheet5,
  • Finally renames Sheets called Sheet1….Sheet5 with a date in the format dd-mmm-yy (i.e. 03-Jan-21, 10-Jan-21, 17-Jan-21, 24-Jan-21 and 31-Jan-21).
Sheet called 03-Jan-21, 10-Jan-21, 17-Jan-21, 24-Jan-21 and 31-Jan-21 contain weekly data and are the ones that this problem relates to.

I have a macro that is called ConsolidateExpenses that is run at the end of the month once all data is entered in the weekly sheets. It extracts required data from the weekly sheets. In the macro there is a statement which reads
VBA Code:
sht = Array("Sheet1", "Sheet2", "Sheet3", "Sheet4", "Sheet5")
.

My problem is that this is the last macro to run in the workbook and prior to getting to this place, sheets called Sheet1, Sheet2, Sheet3, Sheet4 and Sheet5 have been renamed to something like 03-Jan-21, 10-Jan-21, 17-Jan-21, 24-Jan-21 and 31-Jan-21.

Is there a way that the array formula in ConsolidateExpenses can automatically change to
VBA Code:
sht = Array("03-Jan-21”, “10-Jan-21”, “17-Jan-21”, “24-Jan-212”, “31-Jan-21”)

Obviously, for February 21 the array should read
VBA Code:
sht = Array("07-Feb-21”, “14-Feb-21”, “21-Feb-21”, “28-Feb-21”)

The renamed sheet names exist in Sheet called Formula in Cells O3 to O7 and the number of weeks in the month exists in H2.

There is an added complication, which I have. Certain months with have 4 weeks and certain months will have 5 weeks, therefore cell O7 within Formula will have #REF! when there are only 4 weeks as the Sheet5 will have been deleted.

The only way I was thinking of achieving my goal was to do the following in macro called ConsolidateExpenses
  • Getting and storing the renamed sheets names from sheet formula cells O2 to O7;
  • Getting and storing the no of weeks from sheet Formula H2;
  • Renaming the sheets to Sheet1, Sheet2… from their existing names;
  • Setting the array as sht = Array("Sheet1", "Sheet2", "Sheet3", "Sheet4"), if no of weeks is 4 or setting it to sht = Array("Sheet1", "Sheet2", "Sheet3", "Sheet4", "Sheet5") if the number of weeks are 5;
  • Consolidate the data;
  • Renaming the sheets back to what they were.
Hope the above makes sense.

Can anyone suggest a solution?
 

Some videos you may like

Excel Facts

Using Function Arguments with nested formulas
If writing INDEX in Func. Arguments, type MATCH(. Use the mouse to click inside MATCH in the formula bar. Dialog switches to MATCH.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
55,643
Office Version
  1. 365
Platform
  1. Windows
One option is to hide Sheet5 rather than deleting it & use the sheet codenames rather than the sheet names.
 

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows
You could try something like this:
VBA Code:
On Error Resume Next
If IsError(Sheets("Sheet5")) Then
    sht =  Array(Sheets(1).Name, Sheets(2).Name, Sheets(3).Name, Sheets(4).Name)
Else
    sht = Array(Sheets(1).Name, Sheets(2).Name, Sheets(3).Name, Sheets(4).Name, Sheets(5).Name)
End If
On Error GoTo 0
Err.Clear

To replace the current one line statement for the array.
 
Solution

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows
After thinking it over, the IsError statement will not work because Sheet5 will have change names even if it is not deleted, so you would always get the 5 item array and it would produce an error when you only have four sheets.
 

Akuini

Well-known Member
Joined
Feb 1, 2016
Messages
2,962
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

Each workbook has 9-10 sheets with it.
Another option to try:
Put the 4 or 5 sheets in question at the end of tab order. Then use sheets index to populate the sheet name into the array.
Note: tab order is important whenever you use sheet index.
Something like this:
VBA Code:
If Worksheets.Count = 9 Then
    sht = Array(Worksheets(6).Name, Worksheets(7).Name, Worksheets(8).Name, Worksheets(9).Name)
ElseIf Worksheets.Count = 10 Then
    sht = Array(Worksheets(6).Name, Worksheets(7).Name, Worksheets(8).Name, Worksheets(9).Name, Worksheets(10).Name)
End If
 

Kayslover

Board Regular
Joined
Sep 22, 2020
Messages
138
Office Version
  1. 2013
Platform
  1. Windows
Fluff, JLGWhiz, Akuini,

Thank you to the above for taking the time to assist me with me problem, it is appreciated.

Fluff, I may consider your recommendation to hide sheets in the future should the need arise.

Akuini, I could have the sheets at the end as you suggest but I have decided to leave them where they are.

I thought I would try and use Excel’s Internal Sheet names to make life easier which is what JLGWhiz and Akuini were suggesting (I may have got the wrong end of the stick here).

I have create a New Macro based on the OLD macro in the workbook and called it NEW_ConsolidateExpenses.

I am hoping that using Excel’s Internal Sheet names will remedy my problem, but unfortunately I get a
VBA Code:
"Run Time Error 13, Type Mismatch"
.

The line that I get the error is
VBA Code:
With Sheets(sht(i))
.

I am assuming that it has something to do with the Internal Sheet names. I have no idea why this is, and need some assistance from yourselves.

The code that works is in a macro called OLD_ConsolidateExpenses, and it works exactly as I want (although a bit slow). Below I detail briefly what the OLD macro does:-
  • It gets the sheet names and no of weeks in the month from sheet Formula;
  • unprotects appropriate sheets, renames sheets to sheet1 thru sheet5;
  • sets the Array to 4 or 5 sheets depending on the values of no of weeks;
  • does the Consolidation;
  • renames the sheets back to what they were;
  • And finally protects required sheets.
I have create the following file to Dropbox should you want to view the file:-

01 January.xlsm"

The Old macro is:-

VBA Code:
Option Explicit
Public Sub OLD_ConsolidateExpenses()
    
    Dim a()
    Dim sht
    Dim ws As Worksheet
    Dim rf As Range
    Dim i As Integer
    Dim d As Long
    Dim MySheetName1 As String
    Dim MySheetName2 As String
    Dim MySheetName3 As String
    Dim MySheetName4 As String
    Dim MySheetName5 As String
    Dim MyNoOfWeek As Integer
    
    Dim Sheet1 As String
    Dim Sheet2 As String
    Dim Sheet3 As String
    Dim Sheet4 As String
    Dim Sheet5 As String
    
    Dim OldSheet1 As String
    Dim OldSheet2 As String
    Dim OldSheet3 As String
    Dim OldSheet4 As String
    Dim OldSheet5 As String
    
    Dim targetSheet As Worksheet
    Dim lastColumn As Long
    Dim printRange As Range
    Dim lastRow As Long
    
    OldSheet1 = "Sheet1"
    OldSheet2 = "Sheet2"
    OldSheet3 = "Sheet3"
    OldSheet4 = "Sheet4"
    OldSheet5 = "Sheet5"
    
    Application.DisplayAlerts = False
        
'Get the current set Weekly Sheet names from cells O3 to O7. Also get the value of the number of weeks from H2
    
    Sheets("Formula").Select
        MySheetName1 = Range("O3").Value
        MySheetName2 = Range("O4").Value
        MySheetName3 = Range("O5").Value
        MySheetName4 = Range("O6").Value
        MySheetName5 = Range("O7").Value
        MyNoOfWeek = Range("H2").Value
            
'Have to unprotect the Weekly Sheets and Formula sheets.
    
   Sheets(MySheetName1).Unprotect Password:=""
   Sheets(MySheetName2).Unprotect Password:=""
   Sheets(MySheetName3).Unprotect Password:=""
   Sheets(MySheetName4).Unprotect Password:=""
   Sheets("Formula").Unprotect Password:=""
        
   If MyNoOfWeek = 5 Then
       Sheets(MySheetName5).Unprotect Password:=""
   End If

'Rename the weekly sheets to Sheet1 thru Sheet4 as the Array formula needs them to be Sheet1, Sheet2..
        
    Sheets(MySheetName1).Select
    Sheets(MySheetName1).Name = "Sheet1"
    Sheets(MySheetName2).Select
    Sheets(MySheetName2).Name = "Sheet2"
    Sheets(MySheetName3).Select
    Sheets(MySheetName3).Name = "Sheet3"
    Sheets(MySheetName4).Select
    Sheets(MySheetName4).Name = "Sheet4"

'Rename the weekly sheet5 to Sheet5, if the number of weeks is 5 (i.e 5 weeks in the month)

    If MyNoOfWeek = 5 Then
        Sheets(MySheetName5).Select
        Sheets(MySheetName5).Name = "Sheet5"
    End If
    
'If the number of week in the month is 4, then set the array to Sheet1, Sheet2, Sheet3 and Sheet4.

'If the number of week in the month is 5, then rename Weekly Sheet 5 to Sheet5 and then set the array to Sheet1, Sheet2, Sheet3, Sheet4 and Sheet5.

    If MyNoOfWeek = 4 Then
        sht = Array("Sheet1", "Sheet2", "Sheet3", "Sheet4")
    Else
       sht = Array("Sheet1", "Sheet2", "Sheet3", "Sheet4", "Sheet5")
    End If

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    Sheets("Month Expenses").UsedRange.Offset(3).ClearContents
    For i = 0 To UBound(sht)
        With Sheets(sht(i))
            Set rf = .Columns.Find("Ref")
            If Not rf Is Nothing Then
                Set rf = rf.Offset(1).Resize(.Columns(1).Find("B", LookAt:=xlWhole).Row - rf.Row - 1, 10)
                If Not rf Is Nothing Then
                    On Error Resume Next
                    a = rf.Columns(1).SpecialCells(xlCellTypeConstants).Resize(, 10).Value
                    If Err.Number = 0 Then
                        With Sheets("Month Expenses")
                            With .Range("A" & .Cells(Rows.Count, "A").End(3).Row)(2)
                                .Resize(UBound(a), 10) = a
                                Erase a
                            End With
                        End With
                    End If
                    Err.Clear
                End If
            End If
        End With
    Next

'Change the value of the sum in columns E, F and G to paste Values.

    With Sheets("Month Expenses")
        i = .[a3].CurrentRegion.Columns(1).Rows.Count - 3
        With .[e3].Resize(, 3)
            .FormulaR1C1 = "=sum(r[1]c:r[" & i & "]c)"
            .Value = .Value
        End With
    End With
Set rf = Nothing

'Rename the weekly sheets back to what they were.

    Sheets(OldSheet1).Select
    Sheets(OldSheet1).Name = MySheetName1
    Sheets(OldSheet2).Select
    Sheets(OldSheet2).Name = MySheetName2
    Sheets(OldSheet3).Select
    Sheets(OldSheet3).Name = MySheetName3
    Sheets(OldSheet4).Select
    Sheets(OldSheet4).Name = MySheetName4
        
'If the no of weeks is 5, then Rename weekly sheet sheet5 to Original Sheet names
    
    If MyNoOfWeek = 5 Then
        Sheets(OldSheet5).Select
        Sheets(OldSheet5).Name = MySheetName5
    End If

'Protect specific sheets

    Sheets(MySheetName1).Protect
    Sheets(MySheetName2).Protect
    Sheets(MySheetName3).Protect
    Sheets(MySheetName4).Protect
    Sheets("Formula").Protect
    
    If MyNoOfWeek = 5 Then
        Sheets(MySheetName5).Protect
    End If
    
    Sheets("Month Expenses").Select
        
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    
End Sub


The new macro is:-

VBA Code:
Option Explicit

Sub NEW_ConsolidateExpenses()

    Dim a()
    Dim sht
    Dim ws As Worksheet
    Dim rf As Range
    Dim i As Integer
    Dim d As Long
    Dim MyNoOfWeek As Integer
    
    Application.DisplayAlerts = False
        
'Get the no of weeks in the month from sheet Formula, cell H2
    
    Sheets("Formula").Select
        MyNoOfWeek = Range("H2").Value
            
'Have to unprotect the Weekly Sheets and Formula sheets.
    
    Sheet1.Unprotect Password:=""                       '-----this is seen in the VBA Project as Sheet1 (03-Jan-21), but exists as the 1st sheet withing the bookwork.
    Sheet8.Unprotect Password:=""                       '-----this is seen in the VBA Project as Sheet8 (10-Jan-21), but exists as the 2nd sheet withing the bookwork.
    Sheet10.Unprotect Password:=""                      '-----this is seen in the VBA Project as Sheet10 (17-Jan-21), but exists as the 3rd sheet withing the bookwork.
    Sheet11.Unprotect Password:=""                      '-----this is seen in the VBA Project as Sheet11 (24-Jan-21), but exists as the 4th sheet withing the bookwork.
    Sheets("Formula").Unprotect Password:=""         '-----this is seen in the VBA Project as Sheet2 (Formula), but exists as the 10 (last) sheet withing the bookwork.
          
    If MyNoOfWeek = 5 Then
       Sheet12.Unprotect Password:=""                   '-----this is seen in the VBA Project as Sheet12 (31-Jan-21), but exists as the 5th sheet withing the bookwork.
   End If

'If the number of week in the month is 4, then set the array to 4 sheets, otherwise set it to 5 sheets.

    If MyNoOfWeek = 4 Then
        sht = Array(Sheet1, Sheet8, Sheet10, Sheet11)
    Else
        sht = Array(Sheet1, Sheet8, Sheet10, Sheet11, Sheet12)
    End If

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    Sheets("Month Expenses").UsedRange.Offset(3).ClearContents
    For i = 0 To UBound(sht)
       [SIZE=4][B][B] [/B][/B]With Sheets(sht(i))[/SIZE]
            Set rf = .Columns.Find("Ref")
            If Not rf Is Nothing Then
                Set rf = rf.Offset(1).Resize(.Columns(1).Find("B", LookAt:=xlWhole).Row - rf.Row - 1, 10)
                If Not rf Is Nothing Then
                    On Error Resume Next
                    a = rf.Columns(1).SpecialCells(xlCellTypeConstants).Resize(, 10).Value
                    If Err.Number = 0 Then
                        With Sheets("Month Expenses")
                            With .Range("A" & .Cells(Rows.Count, "A").End(3).Row)(2)
                                .Resize(UBound(a), 10) = a
                                Erase a
                            End With
                        End With
                    End If
                    Err.Clear
                End If
            End If
        End With
    Next

'Change the value of the sum in columns E, F and G to paste Values.

    With Sheets("Month Expenses")
        i = .[a3].CurrentRegion.Columns(1).Rows.Count - 3
        With .[e3].Resize(, 3)
            .FormulaR1C1 = "=sum(r[1]c:r[" & i & "]c)"
            .Value = .Value
        End With
    End With
Set rf = Nothing


'Protect specific sheets

    Sheet1.Protect Password:=""
    Sheet8.Protect Password:=""
    Sheet10.Protect Password:=""
    Sheet11.Protect Password:=""
    Sheets("Formula").Unprotect Password:=""
          
    If MyNoOfWeek = 5 Then
       Sheet12.Protect Password:=""
    End If
       
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    
End Sub
.

The line that is 2 below "Sheets("Month Expenses").UsedRange.Offset(3).ClearContents" is the one that is giving the error.

Hope you can help.
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
55,643
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

To use the codenames it needs to be like
VBA Code:
With sht(i)
 

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows
Thanks for the feedback.
Regards, JLG
 

Kayslover

Board Regular
Joined
Sep 22, 2020
Messages
138
Office Version
  1. 2013
Platform
  1. Windows
Fluff,

That was quick, and it worked (as expected).

The New macro runs a lot faster than the old macro.

Many thanks for your kind assistance, moving on to the next task (i am sure you will be hearing from me.;)
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
55,643
Office Version
  1. 365
Platform
  1. Windows
Glad we could help & thanks for the feedback.
 

Watch MrExcel Video

Forum statistics

Threads
1,127,794
Messages
5,626,924
Members
416,209
Latest member
tan21

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
Top