Copy data to another spreadsheet based off value stored in string

Question

I have the below code for one of my financial reports and I'm struggling with updating the code to make it more automated. The code creates a string of the column headers stored in multiple sheets. Each column header is a new tab in wb2. I can't figure out how to get formulas copied into a new address range. it needs to copy the values to that Sheet in wb2 and then move on to the next.

So the code needs to: 1/put the column headers to a string/array [Works] 2/look through string/array and find that column in wb1 [Works] 3/then copy specific ranges to wb2 (name is based of column header/string value) [Works] 4/copy formula into column G, based on row similar to what it does for column A addresses - for example if the range is G9, it needs to copy the formula H9-A9, etc 5/go to next value

Any help or direction would be appreciated.

Sub Prepare_CYTD_Report()
Dim addresses() As String
Dim addresses2() As String
Dim wb1 As Workbook, wb2 As Workbook
Dim my_Filename

'Declare variables for MHP60
Dim i As Long, lastcol As Long
Dim tabNames As Range, cell As Range, tabName As String
'Declare variables for MHP61
Dim i2 As Long, lastCol2 As Long
Dim tabNames2 As Range, cell2 As Range, tabName2 As String
'Declare variables for MHP62
Dim i3 As Long, lastCol3 As Long
Dim tabNames3 As Range, cell3 As Range, tabName3 As String


addresses = Strings.Split("A9,A12:A26,A32:A38,A42:A58,A62:A70,A73:A76,A83:A90", ",") 'Trial Balance string values
addresses2 = Strings.Split("G9,G12:G26,G32:G38,G42:G58,G62:G70,G73:G76,G83:G90", ",")  'Prior Month string values

Set wb1 = ActiveWorkbook    'Trial Balance to Financial Statements Workbook

'*****************************Load Column Header Strings
lastcol = wb1.Sheets("MHP60").Cells(5, Columns.Count).End(xlToLeft).Column
On Error Resume Next
Set tabNames = wb1.Sheets("MHP60").Cells(4, 3).Resize(1, lastcol - 2).SpecialCells(xlCellTypeConstants)
'actual non-formula text values on row 4 from column C up to column lastCol'
On Error GoTo 0
If Err.Number <> 0 Then
    MsgBox "No headers were found on row 4 of MHP60", vbCritical
    Exit Sub
End If

lastCol2 = wb1.Sheets("MHP61").Cells(5, Columns.Count).End(xlToLeft).Column
On Error Resume Next
Set tabNames2 = wb1.Sheets("MHP61").Cells(4, 3).Resize(1, lastcol - 2).SpecialCells(xlCellTypeConstants)
'actual non-formula text values on row 4 from column C up to column lastCol'
On Error GoTo 0
If Err.Number <> 0 Then
    MsgBox "No headers were found on row 4 of MHP61", vbCritical
    Exit Sub
End If

lastCol3 = wb1.Sheets("MHP62").Cells(5, Columns.Count).End(xlToLeft).Column
On Error Resume Next
Set tabNames3 = wb1.Sheets("MHP62").Cells(4, 3).Resize(1, lastcol - 2).SpecialCells(xlCellTypeConstants)
'actual non-formula text values on row 4 from column C up to column lastCol'
On Error GoTo 0
If Err.Number <> 0 Then
    MsgBox "No headers were found on row 4 of MHP62", vbCritical
    Exit Sub
End If

'*****************************Open CYTD/FYTD files
my_Filename = Application.GetOpenFilename(fileFilter:="Excel Files,*.xl*;*.xm*", Title:="Select File to create Reports")

If my_Filename = False Then
    Exit Sub
End If

Application.ScreenUpdating = False
Set wb2 = Workbooks.Open(my_Filename)

'*****************************Copy values to Financial statements workbook
For Each cell In tabNames
    tabName = Strings.Trim(cell.Value2)
    'dedicated variable in case of requirement for further parsing (space/comma elimination?)'
    If CStr(wb1.Sheets("MHP60").Evaluate("ISREF('[" & wb2.Name & "]" & tabName & "'!$A$1)")) = "True" Then
    'If wb2 has a tab named for the value in tabName
        For i = 0 To UBound(addresses)
            wb2.Sheets(tabName).Range(addresses(i)).Value2 = wb1.Sheets("MHP60").Range(addresses(i)).Offset(0, cell.Column - 1).Value2
            'wb2.Sheets(tabName).Range(addresses2(i)).Value2 =
            'Debug.Print "data for " & wb2.Sheets(tabName).Range(addresses(i)).Address(, , , True) & " copied from " & wb1.Sheets("MHP60").Range(addresses(i)).Offset(0, cell.Column - 1).Address(, , , True)
        Next i
    Else
        Debug.Print "A tab " & tabName & " was not found in " & wb2.Name
    End If
Next cell

For Each cell In tabNames2
    tabName2 = Strings.Trim(cell.Value2)
    'dedicated variable in case of requirement for further parsing (space/comma elimination?)'
    If CStr(wb1.Sheets("MHP61").Evaluate("ISREF('[" & wb2.Name & "]" & tabName2 & "'!$A$1)")) = "True" Then
    'If wb2 has a tab named for the value in tabName
        For i = 0 To UBound(addresses)
            wb2.Sheets(tabName2).Range(addresses(i)).Value2 = wb1.Sheets("MHP61").Range(addresses(i)).Offset(0, cell.Column - 1).Value2
            'Debug.Print "data for " & wb2.Sheets(tabName2).Range(addresses(i)).Address(, , , True) & " copied from " & wb1.Sheets("MHP61").Range(addresses(i)).Offset(0, cell.Column - 1).Address(, , , True)
        Next i
    Else
        Debug.Print "A tab " & tabName2 & " was not found in " & wb2.Name
    End If
Next cell

For Each cell In tabNames3
    tabName3 = Strings.Trim(cell.Value2)
    'dedicated variable in case of requirement for further parsing (space/comma elimination?)'
    If CStr(wb1.Sheets("MHP62").Evaluate("ISREF('[" & wb2.Name & "]" & tabName3 & "'!$A$1)")) = "True" Then
    'If wb2 has a tab named for the value in tabName
        For i = 0 To UBound(addresses)
            wb2.Sheets(tabName3).Range(addresses(i)).Value2 = wb1.Sheets("MHP62").Range(addresses(i)).Offset(0, cell.Column - 1).Value2
            'Debug.Print "data for " & wb2.Sheets(tabName2).Range(addresses(i)).Address(, , , True) & " copied from " & wb1.Sheets("MHP62").Range(addresses(i)).Offset(0, cell.Column - 1).Address(, , , True)
        Next i
    Else
        Debug.Print "A tab " & tabName3 & " was not found in " & wb2.Name
    End If
Next cell

Application.ScreenUpdating = True

End Sub

Answer 1

Sub Prepare_CYTD_Report()
    Dim addresses() As String
    Dim wb1 As Workbook, wb2 As Workbook
    Dim i As Long, lastCol As Long, my_FileName
    Dim tabNames As Range, cell As Range, tabName As String
    
    addresses = Strings.Split("A12:A26,A32:A38,A42:A58,A62:A70,A73:A76,A83:A90", ",")
    Set wb1 = ActiveWorkbook    'Trial Balance to Financial Statements
    lastCol = wb1.Sheets("MHP60").Cells(5, Columns.Count).End(xlToLeft).Column
    On Error Resume Next
    Set tabNames = wb1.Sheets("MHP60").Cells(4, 3).Resize(1, lastCol - 2).SpecialCells(xlCellTypeConstants)
    'actual non-formula text values on row 4 from column C up to column lastCol'
    On Error GoTo 0
    If Err.Number <> 0 Then
        MsgBox "No headers were found on row 4 of MHP60", vbCritical
        Exit Sub
    End If
    '*****************************Open CYTD/FYTD files
    my_FileName = Application.GetOpenFilename(FileFilter:="Excel Files,*.xl*;*.xm*")

    If my_FileName = False Then
        Exit Sub
    End If

    Application.ScreenUpdating = False
    Set wb2 = Workbooks.Open(my_FileName)
    
    For Each cell In tabNames
        tabName = Strings.Trim(cell.Value2)
        'dedicated variable in case of requirement for further parsing (space/comma elimination?)'
        If CStr(wb2.Worksheets(1).Evaluate("ISREF('" & tabName & "'!$A$1)")) = "True" Then
        'If wb2 has a tab named for the value in tabName
            For i = 0 To UBound(addresses)
                wb2.Sheets(tabName).Range(addresses(i)).Value2 = wb1.Sheets("MHP60").Range(addresses(i)).Offset(0, cell.Column - 1).Value2
                'Debug.Print "data for " & wb2.Sheets(tabName).Range(addresses(i)).Address(, , , True) & " copied from " & wb1.Sheets("MHP60").Range(addresses(i)).Offset(0, cell.Column - 1).Address(, , , True)
            Next i
        Else
            Debug.Print "A tab " & tabName & " was not found in " & wb2.Name
        End If
    Next cell
    Application.ScreenUpdating = True
End Sub

In view of the observation made in my comment, the code presented above assumes that

• the actual cell values on row 4 of MHP60 are the values 'as is' of the actual tab names
• those cell values were manually entered, i.e. not formula-driven