Clear All Dropdown Listindex

Hi,

I want to clear all contents of cells after completing macro for creating months. Range that needs to be cleared also contains dropdown shapes, which have code for inserting their values into cells under.

I want to set all dropdown Listindex-es to blank (-1), so that all cells in desired range would really be cleared.

Tried with this, but not working :

dim dd as dropdown
dim lngcounter3 as Long

set dd= ActiveSheet.Dropdowns

For lngcounter = 1 to 13
dd.Listindex = -1
next lngcounter

What am I doing wrong ?

See attached sample, and look at Clear_cells and Dropdown_Change macros !

Thanks for help in advance !

Hi Luka,

I'm glad you got the conditional format working.

Try the following to clear the list boxes (tested and working on my computer with your file):

Sub ClearFormsDropDownListBoxes()

  Dim Sh As Object
  
  Dim sShapeName As String
    
  For Each Sh In ActiveSheet.Shapes
  
    'Get the Shape name - remove leading and trailing spaces, and convert to UPPER CASE
    sShapeName = UCase(Trim(Sh.Name))
    
    'If it is a 'DropDown' then clear the list
    If Left(sShapeName, 9) = "DROP DOWN" Then
      ActiveSheet.DropDowns(sShapeName).ListFillRange = ""
    End If
  Next Sh

End Sub

Lewis

My original worked, but I misunderstood what you wanted. I thought you wanted the lists removed. What you really wanted was for each DropDown to be blank.

I tested the following on your sample workbook, and it seemed to be working, including December 1st.

Lewis

Sub Clear_cells()

Dim Sh As Object
Dim sShapeName As String

Dim lngCounter As Long
Dim lngcounter2 As Long
Dim Toggle As Long, cnt_trans As Long


'Delete cell contents, leave formulas

On Error Resume Next
 For lngCounter = 1 To 13
  With Sheets(lngCounter)
  cnt_trans = Application.WorksheetFunction.Match("Transfer", .Range("A2:BZ2"), 0)
    .Unprotect
    
    
    'Set the contents of each 'DropDown' to Index 0 = BLANK
    For Each Sh In Sheets(lngCounter).Shapes
      'Get the Shape name - remove leading and trailing spaces, and convert to UPPER CASE
      sShapeName = UCase(Trim(Sh.Name))
      'If it is a 'DropDown' then clear the list
      If Left(sShapeName, 9) = "DROP DOWN" Then
        If Sheets(lngCounter).DropDowns(sShapeName).ListIndex <> -1 Then
          Sheets(lngCounter).DropDowns(sShapeName).ListIndex = 0
        End If
      End If
    Next Sh
    
    .Range(Cells(3, 5), Cells(397, cnt_trans)).SpecialCells(xlCellTypeConstants).ClearContents 'Range "E3:?397"
   
     End With
 Next lngCounter
 


   'Hide lists on all new sheets
 
On Error Resume Next
 For lngcounter2 = 2 To 13
  With Sheets(lngcounter2)
    .Rows("402:437").EntireRow.Hidden = True
    End With
    Sheets(lngcounter2).Protect
 Next lngcounter2

'Toggle button value

On Error Resume Next
 For Toggle = 2 To 13
  With Sheets(Toggle)
    Sheets(Toggle).ToggleButton1.Value = True
    End With
 Next Toggle

End Sub

Much closer, but still someting wrong with this code.

It does clear all drop-downs, but cells in range still don't clear, not sure why as you made all code before Clear.Contents code

See this screenshot for February !

The .ClearContents line seemed to be causing a lot of problems. I replaced it with a line that sets to "" (NO VALUE) all cells that have 'Data Validation'.

Try this (changes from the previous version I posted are in red):

Sub Clear_cells()

  Dim r As Range
  Dim Sh As Object
  Dim sShapeName As String

  Dim lngCounter As Long
  Dim lngcounter2 As Long
  Dim Toggle As Long, cnt_trans As Long


 'Delete cell contents, leave formulas

  On Error Resume Next
  For lngCounter = 1 To 13
    With Sheets(lngCounter)
      cnt_trans = Application.WorksheetFunction.Match("Transfer", .Range("A2:BZ2"), 0)
      .Unprotect
    
    
      'Set the contents of each 'DropDown' to Index 0 = BLANK
      For Each Sh In Sheets(lngCounter).Shapes
        'Get the Shape name - remove leading and trailing spaces, and convert to UPPER CASE
        sShapeName = UCase(Trim(Sh.Name))
        'If it is a 'DropDown' then clear the list
        If Left(sShapeName, 9) = "DROP DOWN" Then
          If Sheets(lngCounter).DropDowns(sShapeName).ListIndex <> -1 Then
            Sheets(lngCounter).DropDowns(sShapeName).ListIndex = 0
          End If
        End If
      Next Sh
    
      'This line seemed to delete the Master list of times on some sheets
      'Removed this line and replaced it with the line that
      '.Range(Cells(3, 5), Cells(397, cnt_trans)).SpecialCells(xlCellTypeConstants).ClearContents 'Range "E3:?397"
   
      'Find all cells containing data validation
      'Set all data validatation cells to "" (NO VALUE)
      Set r = Sheets(lngCounter).UsedRange.SpecialCells(xlCellTypeAllValidation)
      r.Value = ""
   
    End With
  Next lngCounter

  'Hide lists on all new sheets
  On Error Resume Next
  For lngcounter2 = 2 To 13
    With Sheets(lngcounter2)
      .Rows("402:437").EntireRow.Hidden = True
    End With
    Sheets(lngcounter2).Protect
  Next lngcounter2


 'Toggle button value
  On Error Resume Next
  For Toggle = 2 To 13
    With Sheets(Toggle)
      Sheets(Toggle).ToggleButton1.Value = True
    End With
  Next Toggle

End Sub

Hi LJMetzger,

I allready know that, and thanks to nilem on other thread I have solved this issue. A stupid mistake in this line was done by me:

.Range(.Cells(3, 5), Cells(397, cnt_trans)).SpecialCells(xlCellTypeConstants).ClearContents 'Range "E3:?397"

A DOT was missing, now It works !!! Same goes for your code, thanks a lot !!!