Help with sheet names in an Array using VBA

[Kayslover]

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

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

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

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?

 

[Fluff]

One option is to hide Sheet5 rather than deleting it & use the sheet codenames rather than the sheet names.

 

[JLGWhiz]

You could try something like this:

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.

 

[JLGWhiz]

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]

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:

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]

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

"Run Time Error 13, Type Mismatch"

.

The line that I get the error is

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:-

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:-

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]

To use the codenames it needs to be like

With sht(i)

 

[JLGWhiz]

Thanks for the feedback.
Regards, JLG

 

[Kayslover]

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]

Glad we could help & thanks for the feedback.