Macro (maybe a loop?) That cycles through every option and pastes result onto new sheet

[SPatrick720]

Hi Everyone!

I am trying to create a macro for the below steps but I am new to using this tool and facing issues. Could anyone please help me with this?

In cell D2 of Sheet1, I have a drop-down list with 3 items. In cell D3, users can input a number (0-55). In cell D4, users can input a number (5-100). In cell D5, there is another drop-down list with 6 items. In cell D7, there is the last drop-down list with 4 items. I am trying to create a macro that cycles through every option and then copies the value from D21 into a new sheet each time

1. Select item from drop-down list (D2)
2. Input number (D3)
3. Input number (D4)
4. Select item from drop-down list (D5)
5. Select item from drop-down list (D7)
6. Copy cell D21 and paste in new sheet
7. Repeat until all options have been completed

Thank you in advance for all your help! I really appreciate it!

 

[Yongle]

Welcome to the board...

The VBA below adds a new sheet and lists all DV options
It assumes that the DV source (D2,D5 & D7) is list of items separated by comma - if any are based on a range of cells, the code will require modifying

Let me know how you get on and then the code can be modified to actually run through all options and dump values to output sheet.

(In the output sheet) should VBA simply list the 387072 (= 3 X 56 X 96 X 6 X 4) returned values in column A or should each value also be accompanied by the 5 selected values?

Put this in a standard module. Run from sheet containing the data validation

Sub ListAllValues()

Dim D2 As Variant, D5 As Variant, D7 As Variant
Dim i As Long, r As Long
Dim sh As Worksheet: Set sh = ActiveSheet
Dim ws As Worksheet: Set ws = Sheets.Add(after:=Sheets(Sheets.Count))
On Error Resume Next
    ws.Range("A1").Resize(, 5).Value = Array("D2", "D3", "D4", "D5", "D7")

    D2 = Split(sh.Range("D2").Validation.Formula1, ",")
    ws.Range("A2").Resize(UBound(D2) + 1).Value = WorksheetFunction.Transpose(D2)
    
    With sh.Range("D3").Validation
        r = 1
        For i = .Formula1 To .Formula2
            r = r + 1
            ws.Cells(r, 2) = i
        Next i
    End With
    
    With sh.Range("D4").Validation
        r = 1
        For i = .Formula1 To .Formula2
            r = r + 1
            ws.Cells(r, 3) = i
        Next i
    End With
    
    D5 = Split(sh.Range("D5").Validation.Formula1, ",")
    ws.Range("D2").Resize(UBound(D5) + 1).Value = WorksheetFunction.Transpose(D5)
    
    D7 = Split(sh.Range("D7").Validation.Formula1, ",")
    ws.Range("E2").Resize(UBound(D7) + 1).Value = WorksheetFunction.Transpose(D7)
    
End Sub

 

[SPatrick720]

Thank you for the response! I am actually trying to create a macro that just copies the value from cell D21. The cells I listed are linked to an equation that updates the value in cell D21 which is what needs to be put into the table. Sorry for the confusion!

 

[Yongle]

This code will take a long time to run
Close all other programs before you run it!
Run from the sheet with validation cells
It creates an array of all possible values for each validation cell
It loops through each possible value and creates a new sheet with 387072 values for D21
There are ways to speed things up if it proves unbearably slow to run

Sub ListAllValuesForD21()
Application.ScreenUpdating = False
Dim D2 As Variant, D3 As Variant, D4 As Variant, D5 As Variant, D7 As Variant
Dim e2 As Variant, e3 As Variant, e4 As Variant, e5 As Variant, e7 As Variant
Dim i As Long, r As Long, myStr As String
Dim sh As Worksheet: Set sh = ActiveSheet
Dim ws As Worksheet: Set ws = Sheets.Add(after:=Sheets(Sheets.Count))
On Error Resume Next
    D2 = Split(sh.Range("D2").Validation.Formula1, ",")
    D5 = Split(sh.Range("D5").Validation.Formula1, ",")
    D7 = Split(sh.Range("D7").Validation.Formula1, ",")
    With sh.Range("D3").Validation
        r = 0
        myStr = ""
        For i = .Formula1 To .Formula2
            If r = 0 Then myStr = i Else myStr = myStr & "," & i
            r = r + 1
        Next i
    End With
    D3 = Split(myStr, ",")
    
    With sh.Range("D4").Validation
        r = 0
        myStr = ""
        For i = .Formula1 To .Formula2
            If r = 0 Then myStr = i Else myStr = myStr & "," & i
            r = r + 1
        Next i
    End With
    D4 = Split(myStr, ",")
    r = 0
    For Each e2 In D2
        sh.Range("D2").Value = e2
        For Each e3 In D3
            sh.Range("D3").Value = e3
            For Each e4 In D4
                sh.Range("D4").Value = e4
                For Each e5 In D5
                    sh.Range("D5").Value = e5
                    For Each e7 In D7
                        sh.Range("D7").Value = e7
                        ws.Cells(Rows.Count, 1).End(xlUp).Offset(1) = Range("D21").Value
                    Next e7
                Next e5
            Next e4
        Next e3
    Next e2
    
Application.ScreenUpdating = True
End Sub

 

[SPatrick720]

Thank you!