Loop through two validation lists + copy and paste output to new workbooks and sheets

Bpark · Oct 20th 2022

Sorry if this isn’t accepted, but i’d like to take the below thread and try to modify it to work for the functionality I’m working to accomplish…

Thread

Loop through two validation lists + copy and paste output

Hi there,

I'm trying to create a macro to automate calculation outputs for different variables. Very new to macro so looking for guidance.

In Sheet1, I have 2 dropdown (data validation) lists (one for name in cell A1, one for date in cell A2). I have a pre-built calculation with 2 different outputs in cell B1 and B2. I want to calculate for each name across all the available dates and copy the outputs in cell B1 and B2 to Sheet1 column C and D that match name in column A and date in column B.…

oberyn

Jan 27th 2021

This thread takes the two data validations and cycles through all the potential options and then copies and pastes the values for each iteration on the Output sheet. What I’m trying to accomplish is to take data validation 1 (A-D in this example) and create a new workbook and with data validation 2 (1/1/2021 - 1/10/2021) create the 10 sheets titled 1/1/2021 - 1/10/2021 and copy the sheet (ie in this case Input sheet) and paste on to the respective sheets within each of the four workbooks that are created. So in this case it would be 4 workbooks with 10 sheets.

My data is 7 departments (A-G) that would be data validation 1 and data validation 2 containing the months of the year. So my output would be 7 workbooks with 12 sheets each titled January - December. Ideally I’d love it to take the values of cells A1:I10 and paste values and A11:I60 and paste formulas.

Hope this makes sense!

Bpark · Oct 24th 2022

I have the code working within it's own workbook where it will create a new sheet for each option in the data validations. I cannot, for the life of me, figure out where to add the workbooks.add code (and probably settings) to create individual workbooks for each department. Can someone smarter than I help figure this last piece out?

Attached also is my test version.

Thanks in advance!

Code

Option Explicit

Sub CreateReport()
' Loop Through Both Data Validation Lists - 28 Jan 2021
Dim rng1 As Range, rng2 As Range
Dim dVArray1 As Variant, dVArray2 As Variant
Dim i As Integer, ii As Integer
Dim dVrows1 As Integer, dVrows2 As Integer
Dim last As Long
    
    'Set the cells which contain the Data Validation lists
    Set rng1 = Sheet1.Range("D13")
    Set rng2 = Sheet1.Range("D14")
    
    'Create First Array from the Data Validation formula
    dVrows1 = Range(Replace(rng1.Validation.Formula1, "=", "")).Rows.Count
    ReDim dVArray1(1 To dVrows1)
        For i = 1 To dVrows1
            dVArray1(i) = Range(Replace(rng1.Validation.Formula1, "=", "")).Cells(i, 1)
        Next i

    'Create Second Array from the Data Validation formula
    dVrows2 = Range(Replace(rng2.Validation.Formula1, "=", "")).Rows.Count
    ReDim dVArray2(1 To dVrows2)
        For ii = 1 To dVrows2
            dVArray2(ii) = Range(Replace(rng2.Validation.Formula1, "=", "")).Cells(ii, 1)
        Next ii

    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' Last Step is to actually Loop in order to produce and display Results
    Application.ScreenUpdating = False
    
        'Loop through all the values in Both Data Validation Arrays
        For i = LBound(dVArray1) To UBound(dVArray1)
            'Change the Values in the data validation cells
            rng1.Value = dVArray1(i)
            For ii = LBound(dVArray2) To UBound(dVArray2)
                rng2.Value = dVArray2(ii)
                'Force Excel to recalculate cells B1 and B2
                Application.Calculate
                ' Read The Results ...
                ' and Display Combined Results in Output Sheet
                With Worksheets(Worksheets.Count)
                    Worksheets("Input").Range("A1:I60").Copy
                    .Range("A1:I60").PasteSpecial Paste:=xlPasteValues
                    .Range("A1:I60").PasteSpecial Paste:=xlPasteFormats
                    .Range("A1:I60").PasteSpecial xlPasteColumnWidths
                    .Name = Worksheets("Input").Range("D13") & " - " & Worksheets("Input").Range("D14")
                End With
                
    Sheets.Add After:=Sheets(Sheets.Count)

            Next ii
        Next i

    Application.DisplayAlerts = False
        
    Worksheets(Worksheets.Count).Delete

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

Display More

Bpark · Oct 24th 2022

soooo close yet soooo far.....

Code now will open the workbooks and copy the sheets however it can't save correctly.

Code

Option Explicit

Sub CreateReport()
' Loop Through Both Data Validation Lists - 28 Jan 2021
Dim rng1 As Range, rng2 As Range
Dim dVArray1 As Variant, dVArray2 As Variant
Dim i As Integer, ii As Integer
Dim dVrows1 As Integer, dVrows2 As Integer
Dim last As Long
Dim aname1 As String
Dim aname2 As String
Dim wb As Workbook
Dim wbnew As Workbook

Set wb = ThisWorkbook

aname1 = Worksheets("Input").Range("D11").Value
aname2 = Worksheets("Input").Range("D13").Value
    
    'Set the cells which contain the Data Validation lists
    Set rng1 = Sheet1.Range("D13")
    Set rng2 = Sheet1.Range("D14")
    
    'Create First Array from the Data Validation formula
    dVrows1 = Range(Replace(rng1.Validation.Formula1, "=", "")).Rows.Count
    ReDim dVArray1(1 To dVrows1)
        For i = 1 To dVrows1
            dVArray1(i) = Range(Replace(rng1.Validation.Formula1, "=", "")).Cells(i, 1)
        Next i

    'Create Second Array from the Data Validation formula
    dVrows2 = Range(Replace(rng2.Validation.Formula1, "=", "")).Rows.Count
    ReDim dVArray2(1 To dVrows2)
        For ii = 1 To dVrows2
            dVArray2(ii) = Range(Replace(rng2.Validation.Formula1, "=", "")).Cells(ii, 1)
        Next ii

    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' Last Step is to actually Loop in order to produce and display Results
    Application.ScreenUpdating = False
    
        'Loop through all the values in Both Data Validation Arrays
        For i = LBound(dVArray1) To UBound(dVArray1)
            'Change the Values in the data validation cells
            rng1.Value = dVArray1(i)
                       
            Workbooks.Add

            Set wbnew = ActiveWorkbook
            
            For ii = LBound(dVArray2) To UBound(dVArray2)
                rng2.Value = dVArray2(ii)
                'Force Excel to recalculate cells B1 and B2
                Application.Calculate
                ' Read The Results ...
                ' and Display Combined Results in Output Sheet
                With wbnew.Worksheets(Worksheets.Count)
                    wb.Worksheets("Input").Range("A1:I60").Copy
                    .Range("A1:I60").PasteSpecial Paste:=xlPasteValues
                    .Range("A1:I60").PasteSpecial Paste:=xlPasteFormats
                    .Range("A1:I60").PasteSpecial xlPasteColumnWidths
                    .Name = wb.Worksheets("Input").Range("D14")
                End With
                
    Sheets.Add After:=Sheets(Sheets.Count)

            Next ii
            
            Application.DisplayAlerts = False
        
                Worksheets(Worksheets.Count).Delete
                    
                Application.DisplayAlerts = True
            
        Next i
        
                    ActiveWorkbook.SaveAs Filename:=aname1 & " " & aname2 & ".xlsx", FileFormat:=51
                    ActiveWorkbook.Close

    Application.ScreenUpdating = True
    
End Sub

Display More

Bpark · Oct 25th 2022

Holy cow! I figured it out!

Even though neither of them will probably ever know it, but thanks to Carim for the path to the solution and oberyn for having a similar problem.

Code

Option Explicit

Sub CreateReport()
' Loop Through Both Data Validation Lists - 28 Jan 2021
Dim rng1 As Range, rng2 As Range
Dim dVArray1 As Variant, dVArray2 As Variant
Dim i As Integer, ii As Integer
Dim dVrows1 As Integer, dVrows2 As Integer
Dim last As Long
Dim aname1 As String
Dim wb As Workbook
Dim wbnew As Workbook

Set wb = ThisWorkbook

aname1 = Worksheets("Input").Range("D11").Value
    
    'Set the cells which contain the Data Validation lists
    Set rng1 = Sheet1.Range("D13")
    Set rng2 = Sheet1.Range("D14")
    
    'Create First Array from the Data Validation formula
    dVrows1 = Range(Replace(rng1.Validation.Formula1, "=", "")).Rows.Count
    ReDim dVArray1(1 To dVrows1)
        For i = 1 To dVrows1
            dVArray1(i) = Range(Replace(rng1.Validation.Formula1, "=", "")).Cells(i, 1)
        Next i

    'Create Second Array from the Data Validation formula
    dVrows2 = Range(Replace(rng2.Validation.Formula1, "=", "")).Rows.Count
    ReDim dVArray2(1 To dVrows2)
        For ii = 1 To dVrows2
            dVArray2(ii) = Range(Replace(rng2.Validation.Formula1, "=", "")).Cells(ii, 1)
        Next ii

    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' Last Step is to actually Loop in order to produce and display Results
    Application.ScreenUpdating = False
    
        'Loop through all the values in Both Data Validation Arrays
        For i = LBound(dVArray1) To UBound(dVArray1)
            'Change the Values in the data validation cells
            rng1.Value = dVArray1(i)
                       
            Workbooks.Add

            Set wbnew = ActiveWorkbook
            
            For ii = LBound(dVArray2) To UBound(dVArray2)
                rng2.Value = dVArray2(ii)
                'Force Excel to recalculate cells B1 and B2
                Application.Calculate
                ' Read The Results ...
                ' and Display Combined Results in Output Sheet
                With wbnew.Worksheets(Worksheets.Count)
                    wb.Worksheets("Input").Range("A1:I60").Copy
                    .Range("A1:I60").PasteSpecial Paste:=xlPasteValues
                    .Range("A1:I60").PasteSpecial Paste:=xlPasteFormats
                    .Range("A1:I60").PasteSpecial xlPasteColumnWidths
                    .Name = wb.Worksheets("Input").Range("D14")
                End With
                
    Sheets.Add After:=Sheets(Sheets.Count)

            Next ii
            
            Application.DisplayAlerts = False
        
                Worksheets(Worksheets.Count).Delete
                
                ActiveWorkbook.SaveAs Filename:=aname1 & " " & rng1.Value & ".xlsx", FileFormat:=51
                ActiveWorkbook.Close
                    
            Application.DisplayAlerts = True
            
        Next i

    Application.ScreenUpdating = True
    
End Sub

Display More

Loop through two validation lists + copy and paste output to new workbooks and sheets

Bpark Oct 25th 2022

Participate now!

Share

Similar Threads

Making an invoice by hitting the commandbutton