Search code examples
exceldynamic-arrays

Dynamic Array to store sheet Name


Hye What I am trying to do is:

  • Merge sheet from others workbook
  • using the data on merge sheet to perform calculation and obtain the result
  • the result will be pasted on their sheet
  • after the calculation is done make summary tab that combine all the data in this tab
  • save the summary tab and others merge tab to the new workbook

My problem is: I want to replace this twb.Sheets(Array("Summary", "M 100P 1", "M 100P 2", "M 100P 5", "M 100P 6", "M 100P 12", "M 100P 13", "M 100P 15", "M 100P 16")).Copy with a dynamic array because the name of the merge sheet follow their original file and it might be vary That I cannot use "Like" condition so I try to use the code below but it return myArray is empty

Option Base 1
Sub SheetsArr()
    Dim myArray() As String
    Dim myCount As Integer, NumSheets As Integer

    NumSheets = ThisWorkbook.Worksheets.Count - 4
    ReDim myArray(1 To NumSheets)

    For myCount = 4 To NumSheets
        myArray(myCount) = ActiveWorkbook.Sheets(myCount).Name
    Next myCount
End Sub

Got error

Type Mismatch error

and highlight this line of code on the main module If UBound(myArray) > 0 Then Worksheets(myArray).Copy

Here is my main module code:

Private Sub OpenWorkBook_Click()
    'for merge sheet from other workbooks
    Dim wbk, twb As Workbook
    Dim sPath, sFile, sName, mySheet As String
    Dim cpt, wsCountMerge, wsCount, WsIndex As Integer

    sPath = "C:\Users\mazman\Desktop\Hilmi\data Summary\" 'Your folder path
    sFile = Dir(sPath & "*.xls*")

    Set twb = ThisWorkbook
    Application.ScreenUpdating = 0

    Countmergesheet = 0
    Do While sFile <> "" 'merge raw data sheet process start here
        Set wbk = Workbooks.Open(sPath & sFile)

        With wbk
            sName = Split(Split(.Name, "_")(6), ".")(0) 'initialize sheet name based on the file name
            .Sheets(3).Copy after:=twb.Sheets(twb.Sheets.Count) 'copy each sheets(3) from the data summary and paste after visible sheet on this workbook
            .Close 0
        End With

        With twb
        .ActiveSheet.Name = sName 'rename sheet
        .ActiveSheet.Range("A1:R1").RowHeight = 45
        .ActiveSheet.Range("A1:R1").WrapText = True
        .ActiveSheet.Range("A1:R1").Interior.ColorIndex = 15
        End With
        sFile = Dir()

        If twb.ActiveSheet.Name = sName Then
            Countmergesheet = Countmergesheet + 1 'count how many sheet is merge
        End If
    Loop

    wsCount = twb.Sheets.Count
    wsCountMerge = wsCount - Countmergesheet 'to get the 1st merge sheet index
    WsIndex = wsCount - 1 'to get the last sheet index

    '################# This section copy data from origin sheet #################
    '###### to formula sheet then paste result to its origin sheet ##############
    For i = wsCountMerge To WsIndex
    With twb
    .Sheets(i).Range("A2:R3063").Copy
    .Worksheets("STEP 1").Range("A3").PasteSpecial xlPasteValues

    .Sheets(i).Cells.Clear
    .Sheets(3).Range("A9:O27").Copy
    .Sheets(i).Range("A1").PasteSpecial xlPasteAllUsingSourceTheme
    .Sheets(i).Range("A1").PasteSpecial xlPasteValues
    .Sheets(i).Range("A1:O19").ColumnWidth = 10.8

    '################# This section copy data to summary sheet ################
    .Sheets(i).Range("A2:O18").Copy
    .Worksheets("Summary").Select
    ActiveSheet.Range("B" & Rows.Count).End(xlUp).Offset(1).Select
    ActiveSheet.Paste

    For j = 1 To 17
    ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(1).Select
    ActiveCell.Value = .Sheets(i).Name
    ActiveCell.BorderAround , xlThin
    Next j

    .Worksheets("STEP 1").Range("A3:R6034").Clear
    .Worksheets("STEP 1").Activate: .Sheets("STEP 1").Cells(1).Select
    .Sheets(i).Activate: .Sheets(i).Cells(1).Select
    .Sheets("Summary").Activate: .Sheets("Summary").Cells(1).Select
    '######                   End of section                   ################

    End With
    Next i

    Call InsertFormulas
    Call SheetsArr

    If UBound(myArray) > 0 Then Sheets(myArray).Copy
    ActiveWorkbook.SaveAs Filename:=sPath & "Summary Report" & ".xlsx"
End Sub

Solution

  • Your ReDim makes myArray start from 1. But the for-loop counter, myCount, starts from 4.

    I correct the for-loop counter, myCount, start from 1 as below.

    Sub SheetsArr()
        Dim myArray() As Variant
        Dim myCount As Long, NumSheets As Long
    
        NumSheets = ThisWorkbook.Worksheets.Count - 4
        ReDim myArray(1 To NumSheets)
    
        For myCount = 1 To NumSheets
            myArray(myCount) = ActiveWorkbook.Sheets(myCount).Name
        Next myCount
    End Sub
    

    new answer

    According your main module code, I think you could

    Step 1.

    rewrite your SheetArr() sub to a function as below.

    Option Base 1
    Function SheetsArr() As Variant
        Dim myArray() As Variant  'from String to Variant
        Dim myCount As Long, NumSheets As Long  'from Integer to Long
    
        NumSheets = ThisWorkbook.Worksheets.Count - 4
        ReDim myArray(1 To NumSheets)
    
        For myCount = 1 To NumSheets
            myArray(myCount) = ThisWorkbook.Worksheets(myCount).Name 'from ActiveWorkbook.Sheets to ThisWorkbook.Worksheets as the definition of NumSheets
        Next myCount
        SheetsArr = myArray
    End Function
    

    step 2.

    In main module, you need to add

    Dim myArray As Variant
    

    rewrite

    Call SheetsArr
    

    to

    myArray = SheetsArr()