Share via

VBA Code to select each item in a data validation list

Anonymous
2016-08-09T13:56:45+00:00

Currently, I have a macro on my workbook that will basically take screenshots of certain sheets and put them in a powerpoint presentation with a click of a button. The code works great, however, one of my sheets has graphs that can change depending on the input they pick from the validation list (on the same sheet as the graph). The current code will only pull the graph that is currently shown and not cycle through the validation list and pull each different graph. I need help doing this. I should note that this validation list is based on user input so it needs to be flexible, I cannot pre-input what will be in this list.

Below is my current macro (I only included the code  for the sheet I need help with)

Sub WorkbooktoPowerPoint()

'Step 1: Declare your variables

Dim pp As Object

Dim PPPres As Object

Dim PPSlide As Object

Dim xlwksht As Worksheet

Dim MyRange1 As String

Dim MyRange2 As String

Dim MyRange3 As String

Dim MyTitle As String

'Step 2: Open PowerPoint, add a new presentation and make visible

Set pp = CreateObject("PowerPoint.Application")

Set PPPres = pp.Presentations.Add

pp.Visible = True

'Step 3: Set the ranges for your data and title

MyRange1 = "A1:S31"

If Sheets("User Interface").Range("F18") = "YES" Then

    'Step 4: Start the loop through each worksheet

    Set xlwksht = ActiveWorkbook.Worksheets("Forecast Throughput")

    xlwksht.Select

    Application.Wait (Now + TimeValue("0:00:1"))

    'Step 5: Copy the range as picture

    xlwksht.Range(MyRange1).CopyPicture _

    Appearance:=xlScreen, Format:=xlPicture

    'Step 6: Count slides and add new blank slide as next available slide number

    '(the number 12 represents the enumeration for a Blank Slide)

    SlideCount = PPPres.Slides.Count

    Set PPSlide = PPPres.Slides.Add(SlideCount + 1, 12)

    PPSlide.Select

    'Step 7: Paste the picture and adjust its position

    PPSlide.Shapes.Paste.Select

    pp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True

    pp.ActiveWindow.Selection.ShapeRange.Top = 30

    pp.ActiveWindow.Selection.ShapeRange.Left = 10

    pp.ActiveWindow.Selection.ShapeRange.Width = 700

    'Step 8: Add the title to the slide then move to next worksheet

    Set xlwksht = ActiveWorkbook.Worksheets("Forecast Throughput")

    xlwksht.Select

    Application.Wait (Now + TimeValue("0:00:1"))

End If

'Step 9: Memory Cleanup

pp.Activate

Set PPSlide = Nothing

Set PPPres = Nothing

Set pp = Nothing

Sheets("User Interface").Select

End Sub

Microsoft 365 and Office | Excel | For home | Windows

Locked Question. This question was migrated from the Microsoft Support Community. You can vote on whether it's helpful, but you can't add comments or replies or follow the question.

0 comments
Answer accepted by question author
  1. Anonymous
    2016-08-15T15:09:59+00:00

    v = Range(Replace(r.Validation.Formula1, "=", "")).Value

        If IsArray(v) Then

            For i = LBound(v) To UBound(v)

                r.Value = v(i, 1)

                Application.Calculate

                '.......

            Next i

        Else

            r.Value = v

            Application.Calculate

            '.......

       End If

    0 comments
Answer accepted by question author
  1. Anonymous
    2016-08-11T19:00:30+00:00

    Replace

    v = Split(r.Validation.Formula1, ",")

    For i = LBound(v) To UBound(v)

    r.Value = v(i)

    Application.Calculate

    with

        v = Range(Replace(r.Validation.Formula1, "=", "")).Value

        For i = LBound(v) To UBound(v)

            r.Value = v(i, 1)

            Application.Calculate

    0 comments

6 additional answers

Sort by: Most helpful
Most helpful Newest Oldest
  1. Anonymous
    2016-08-09T17:47:17+00:00

    It works for me as long as the DV on ****"Forecast Throughput" cell M4 is the list option. You did say "validation list" in your first post....

    0 comments
  2. Anonymous
    2016-08-09T17:04:40+00:00

    To loop through all possible values in a DV list, use 

    Sub TestMacro()

        Dim r As Range

        Dim v As Variant

        Dim i As Integer

        'Change B2 to the actual cell

         Set r = Worksheets("Forecast Throughput").Range("B2")   

        v = Split(r.Validation.Formula1, ",")

        For i = LBound(v) To UBound(v)

            r.Value = v(i)

            Application.Calculate

            'code to capture screen and place in PPT presentation

        Next i

    End Sub

    Hi Bernie,

    Unfortunately, when I plus in that code, it is not looping through the DV list. I may have imported it in the wrong places. Please see below for the full code I am using (I bolded where I entered your code). Thanks!

    Sub WorkbooktoPowerPoint()

    'Step 1: Declare your variables

    Dim pp As Object

    Dim PPPres As Object

    Dim PPSlide As Object

    Dim xlwksht As Worksheet

    Dim MyRange1 As String

    Dim MyRange2 As String

    Dim MyRange3 As String

    Dim MyTitle As String

    Dim r As Range

    Dim v As Variant

    Dim i As Integer

    Set r = Worksheets("Forecast Throughput").Range("M4")

    'Step 2: Open PowerPoint, add a new presentation and make visible

    Set pp = CreateObject("PowerPoint.Application")

    Set PPPres = pp.Presentations.Add

    pp.Visible = True

    'Step 3: Set the ranges for your data and title

    MyRange1 = "A1:S31" '<<

    MyRange2 = "A1:S70"

    MyRange3 = "A1:S30"

    If Sheets("User Interface").Range("F18") = "YES" Then

    v = Split(r.Validation.Formula1, ",")

    For i = LBound(v) To UBound(v)

    r.Value = v(i)

    Application.Calculate

            'Step 4: Start the loop through each worksheet

            Set xlwksht = ActiveWorkbook.Worksheets("Forecast Throughput")

            xlwksht.Select

            Application.Wait (Now + TimeValue("0:00:1"))

            'Step 5: Copy the range as picture

            xlwksht.Range(MyRange1).CopyPicture _

            Appearance:=xlScreen, Format:=xlPicture

            'Step 6: Count slides and add new blank slide as next available slide number

            '(the number 12 represents the enumeration for a Blank Slide)

            SlideCount = PPPres.Slides.Count

            Set PPSlide = PPPres.Slides.Add(SlideCount + 1, 12)

            PPSlide.Select

            'Step 7: Paste the picture and adjust its position

            PPSlide.Shapes.Paste.Select

            pp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True

            pp.ActiveWindow.Selection.ShapeRange.Top = 30

            pp.ActiveWindow.Selection.ShapeRange.Left = 10

            pp.ActiveWindow.Selection.ShapeRange.Width = 700

            'Step 8: Add the title to the slide then move to next worksheet

            Set xlwksht = ActiveWorkbook.Worksheets("Forecast Throughput")

            xlwksht.Select

            Application.Wait (Now + TimeValue("0:00:1"))

    Next i

    End If

    If Sheets("User Interface").Range("F20") = "YES" Then

        'Step 4: Start the loop through each worksheet

        Set xlwksht = ActiveWorkbook.Worksheets("Capacity Action List")

        xlwksht.Select

        Application.Wait (Now + TimeValue("0:00:1"))

        'Step 5: Copy the range as picture

        xlwksht.Range(MyRange2).CopyPicture _

        Appearance:=xlScreen, Format:=xlPicture

        'Step 6: Count slides and add new blank slide as next available slide number

        '(the number 12 represents the enumeration for a Blank Slide)

        SlideCount = PPPres.Slides.Count

        Set PPSlide = PPPres.Slides.Add(SlideCount + 1, 12)

        PPSlide.Select

        'Step 7: Paste the picture and adjust its position

        PPSlide.Shapes.Paste.Select

        pp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True

        pp.ActiveWindow.Selection.ShapeRange.Top = 30

        pp.ActiveWindow.Selection.ShapeRange.Left = 10

        pp.ActiveWindow.Selection.ShapeRange.Width = 700

    End If

    If Sheets("User Interface").Range("F22") = "YES" Then

        'Step 4: Start the loop through each worksheet

        Set xlwksht = ActiveWorkbook.Worksheets("Cell Summary")

        xlwksht.Select

        Application.Wait (Now + TimeValue("0:00:1"))

        'Step 5: Copy the range as picture

        xlwksht.Range(MyRange3).CopyPicture _

        Appearance:=xlScreen, Format:=xlPicture

        'Step 6: Count slides and add new blank slide as next available slide number

        '(the number 12 represents the enumeration for a Blank Slide)

        SlideCount = PPPres.Slides.Count

        Set PPSlide = PPPres.Slides.Add(SlideCount + 1, 12)

        PPSlide.Select

        'Step 7: Paste the picture and adjust its position

        PPSlide.Shapes.Paste.Select

        pp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True

        pp.ActiveWindow.Selection.ShapeRange.Top = 30

        pp.ActiveWindow.Selection.ShapeRange.Left = 10

        pp.ActiveWindow.Selection.ShapeRange.Width = 700

    End If

    'Step 9: Memory Cleanup

    pp.Activate

    Set PPSlide = Nothing

    Set PPPres = Nothing

    Set pp = Nothing

    Sheets("User Interface").Select

    End Sub

    0 comments
  3. Anonymous
    2016-08-09T15:11:04+00:00

    To loop through all possible values in a DV list, use 

    Sub TestMacro()

        Dim r As Range

        Dim v As Variant

        Dim i As Integer

        'Change B2 to the actual cell

         Set r = Worksheets("Forecast Throughput").Range("B2")   

        v = Split(r.Validation.Formula1, ",")

        For i = LBound(v) To UBound(v)

            r.Value = v(i)

            Application.Calculate

            'code to capture screen and place in PPT presentation

        Next i

    End Sub

    0 comments