Data Validation‎ > ‎

Cycle Through

PROBLEM: "I have a data validation list in a specific cell, the choice I make in that one cell causes my entire sheet to recalculate for the department chosen.  I need to cycle through every option in that drop down and print the sheet, once for each possible value.
 
 
SPECIFICATIONS:
  1. Only need to identify which cell to operate from in the macro, colored in the macro below
  2. Data Validation list is not to be defined in the macro, the macro should detect the listrange automatically
  3. Macro selects each item from that DV list and reprints the active sheet, then repeats
  4. Added ability to cycle through a DV list that is built in rather than based on a range of cells, too

CODE

Option Explicit

Sub CycleThroughDataValidationOptions()
'Author:    Jerry Beaucaire,  8/25/2011
'Summary:   Cycle through all the options in a drop down for a specific cell
'           7/17/2012 - added ability to process builtin DV lists, too.
Dim MyCell As Range, myDVList As Variant
Dim DVCnt As Long, Itm As Long

'set the cell address here
    Set MyCell = Range("B1")
   
'retrieve the DV source range from the cell
    If Left(MyCell.Validation.Formula1, 1) = "=" Then      'formulaic list
        myDVList = Mid(MyCell.Validation.Formula1, 2, 99)
        DVCnt = Range(myDVList).Cells.Count
        For Itm = 1 To DVCnt                                'cycle one item at a time
            If Range(myDVList).Cells(Itm) <> "" Then        'eliminate blanks
                MyCell = Range(myDVList).Cells(Itm)         'select the item
                ActiveSheet.PrintOut                        'do something here...
            End If
        Next Itm
    Else                                                    'builtin list
        myDVList = Split(MyCell.Validation.Formula1, ",")
        For Itm = 0 To UBound(myDVList)                     'cycle one item at a time
            If myDVList(Itm) <> "" Then                     'eliminate blanks
                MyCell.Value = myDVList(Itm)                'select the item
                ActiveSheet.PrintOut                        'do something here...
            End If
        Next Itm
    End If
End Sub




Nothing says "thanks" like a steak dinner!
PayPal - The safer, easier way to pay online!
Comments