VBA Script Needed to Hide Checkboxes Based on Column Values

Hi,

I am new to posting on the forum and not a regular user of VBA. I have reviewed several other similar posts and tried to implement those solutions, but have not been successful. My worksheet contains the following:

- Column G includes fifteen rows of a formula (beginning at G9) that returns a dynamic list of values based on criteria chosen through a dropdown box. The list can be anywhere from five to 20 values depending on the selection. When the potential matching values for the list are exhausted, the formula returns ""
- Column F includes one checkbox for each of the 20 rows containing the formula.

I need a script that will hide each checkbox that is next to a "blank" value. That is, if the cell in Column G = "", I need the corresponding checkbox to be invisible. Unfortunately, hiding the entire row is not an option. If the script could uncheck the boxes when hidden, that would be a bonus, but isn't absolutely necessary.

Thanks!

Hi,

The attached file should do what you want but the CheckBoxes MUST BE named 'CheckBox1' thru 'CheckBox20'.
If they are not named as such the following two Macros (also in the file) should help you rename them.

This macro displays information about all 'Shapes' on the active sheet (including CheckBoxes):

Sub LoopThroughShapes()

  Dim Sh As Object
  Dim iCount As Integer
    
  For Each Sh In ActiveSheet.Shapes
  
    iCount = iCount + 1
    Debug.Print Format(iCount, "00  ") & "Shape Name = " & Sh.Name & "   Top = "; Sh.Top & "   Left = "; Sh.Left & "   Visible = " & Sh.Visible
  
  Next Sh
  
End Sub

This macro renames Shapes:

Sub RenameShapesIfNecessary()
  'This renames Shapes as required
  
  Dim sOldName As String
  Dim sNewName As String
  
  'Edit the following two lines as required
  sOldName = "CheckBoxX"
  sNewName = "CheckBox1"
  
  ActiveSheet.Shapes(sOldName).Name = sNewName
End Sub

The following macros:
a. Display all CheckBoxes
b. Do the CheckBox manipulation you requested.

Option Explicit


Sub ShowAllCheckBoxes()

  Dim i As Integer
  
  Dim sCheckBoxName As String

  'Turn error checking off to prevent a run time error caused by a bad CheckBox name or missing CheckBox
  On Error Resume Next
  For i = 1 To 20
    sCheckBoxName = "CheckBox" & i
    ActiveSheet.Shapes(sCheckBoxName).Visible = True
  Next i
  On Error GoTo 0

End Sub


Sub TraverseCheckBoxes()

  'Define the data range
  Const sColumnRange = "G9:G28"
  
  Dim r As Range

  Dim i As Integer
  
  Dim sCheckBoxName As String
  Dim sValue As String
  
  For Each r In Range(sColumnRange)
  
    'Increment the CheckBox number
    'Create the CheckBox Name
    i = i + 1
    sCheckBoxName = "CheckBox" & i
    
    'Get the next value in Columnn G
    sValue = Trim(r.Text)
    
    Debug.Print Format(i, "00  ") & r.Address(False, False) & "  " & r.Text
    
    'Turn error checking off to prevent a run time error caused by a bad CheckBox name or missing CheckBox
    'If there is a value in Column G:
    'a. Make the corresponding CheckBox visible
    '
    'If there is NO value in Column G:
    'a. Make the corresponding Checkbox visible
    'b. Uncheck the checkbox (must be visible for this to happen)
    'c. Make the corresponding Checkbox invisible
    On Error Resume Next
    If Len(sValue) > 0 Then
      ActiveSheet.Shapes(sCheckBoxName).Visible = True
    Else
      ActiveSheet.Shapes(sCheckBoxName).Visible = True
      ActiveSheet.OLEObjects(sCheckBoxName).Object.Value = False
      ActiveSheet.Shapes(sCheckBoxName).Visible = False
    End If
    On Error GoTo 0
    
  Next r

End Sub

Lewis

Hi Lewis,

Thank you so much! This gets me very close. The only rub is that I need the script to run any time there is a change in the values in Column G. Can I insert a line to this effect in the script you have provided? The list of values in column G increases and decreases in length based on criteria selected from a drop-down box, so the script needs to run any time there is a change in column G values. Does this make sense?

Again, many thanks for a great solution.

Hi again,

I think the attached file does what you want and incorporates all the following code. You should probably delete the macros from the previous solution and replace them with the new macros. The new solution requires:
a. Workbook_Open() to store the original values in column G. This is needed when a formula changes one or more of the values in Column G.
b. Worksheet_Calculate() to update the CheckBoxes when a formula changes one or more of the values in Column G.
c. Worksheet_Change() to update a CheckBox when the corresponding value in Column G changes.

This incorporates the ability for a cell in another Sheet to change the value in Column G via formula.

VERY IMPORTANT - It is ASSUMED that the 'Column G' data is on "Sheet1". If this is NOT the case, then the value of 'sSheetForColumn_G_RANGE' on line 4 of Module 'ModCheckBoxes' MUST BE CHANGED to the name of the proper SHEET.

I tested the code pretty thoroughly. Please let me know if you have any problems or questions.

Lewis


Code in Module 'ThisWorkbook':

Private Sub Workbook_Open()

  'Debug.Print "Worksheet_Open() at " & Now()
  
  'Initialize the array that determines if a 'Calculate' Event changed a value in Column 'G'
  Call GenerateInitialColumnGArrayValues
  
  'Initialize the Check Boxes to be in the proper state (visible or not visible)
  'When (not visible) the 'CheckBox Value' is set to 'False' (unchecked)
  Call TraverseCheckBoxes

End Sub

Code in Module 'Sheet1':

Option Explicit

Private Sub Worksheet_Calculate()
  'This is called each time a calculate event (manual or automatic) is performed on the Sheet
  'This often occurs when a formula changes the value of a cell

  'Debug.Print "Worksheet_Calculate() at " & Now()
  Call ColumnGRangeCalculateEventHandler
  
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
  'This is called each time a cell on the Sheet is manually changed
  
  'Debug.Print "Worksheet_Change() on cell '" & Target.Address(False, False) & "' at " & Now()
  
  'When a value in the 'Column G' range is changed the 'Event Handler' is called
  If Not Intersect(Target, Target.Worksheet.Range(sColumn_G_RANGE)) Is Nothing Then
    Call ColumnGRangeChangeEventHandler(Target)
  End If
  
End Sub

Code in Module 'ModCheckBoxes':

Option Explicit

  'Define the 'Column G' data range
  Public Const sSheetForColumn_G_RANGE = "Sheet1"
  Public Const sColumn_G_RANGE = "G9:G28"
  
  'Define a data array to store the original values in Column G
  'This is needed for the 'Calculate' Event (when a formula changes a value in Columnn G)
  Public ColumnGArray(9 To 28) As Variant
  
Sub GenerateInitialColumnGArrayValues()
  'This initializes the array that contains the previous values in the 'Columnn G' range
  'The array is used to determine if a value in the range has changed when there is a 'Worksheet_Calculate()' Event.

  Dim myRange As Range

  Dim iBaseRow As Integer
  Dim iRow As Integer
  
  Dim sCell As String
  
  'Get the Base Row for the 'Columnn G' Range (row that contains checkbox 1)
  Set myRange = Range(sColumn_G_RANGE)
  iBaseRow = myRange.Row
  
  'Set the initial values
  For iRow = LBound(ColumnGArray) To UBound(ColumnGArray)
    sCell = "G" & iRow
    ColumnGArray(iRow) = Sheets(sSheetForColumn_G_RANGE).Range(sCell).Value
  Next iRow

End Sub


Sub ColumnGRangeChangeEventHandler(r As Range)
  'This is called by Worksheet_Change() each time
  'a value in the 'Column G' range is manually changed.
  '
  'This is also called by ColumnGRangeCalculateEventHandler() each time
  'a value in the 'Column G; range is changed by formula.

  Dim myRange As Range
  
  Dim iBaseRow As Integer
  Dim iCheckBoxNumber As Integer
  Dim iRow As Integer
  
  Dim sCheckBoxName As String
  Dim sValue As String
  
  'Get the 'Row Number' and 'Value' for the changed cell (r)
  iRow = r.Row
  sValue = Trim(r.Text)
  
  'Get the Base Row for the 'Columnn G' Range (row that contains checkbox 1)
  Set myRange = Sheets(sSheetForColumn_G_RANGE).Range(sColumn_G_RANGE)
  iBaseRow = myRange.Row

  'Calculate the CheckBox Number based on the changed cell (r) and the base row
  'Generate the 'CheckBox' Name
  iCheckBoxNumber = iRow - iBaseRow + 1
  sCheckBoxName = "CheckBox" & iCheckBoxNumber
  
  'Turn error checking off to prevent a run time error caused by a bad CheckBox name or missing CheckBox
  'If there is a value in Column G:
  'a. Make the corresponding CheckBox visible
  '
  'If there is NO value in Column G:
  'a. Make the corresponding Checkbox visible
  'b. Uncheck the checkbox (must be visible for this to happen)
  'c. Make the corresponding Checkbox invisible
  On Error Resume Next
  If Len(sValue) > 0 Then
    Sheets(sSheetForColumn_G_RANGE).Shapes(sCheckBoxName).Visible = True
  Else
    Sheets(sSheetForColumn_G_RANGE).Shapes(sCheckBoxName).Visible = True
    Sheets(sSheetForColumn_G_RANGE).OLEObjects(sCheckBoxName).Object.Value = False
    Sheets(sSheetForColumn_G_RANGE).Shapes(sCheckBoxName).Visible = False
  End If
  On Error GoTo 0

End Sub

  
Sub ColumnGRangeCalculateEventHandler()
  'This is called by Worksheet_Calculate() each time
  'a value in the 'Column G' range is changed by formula.
  
  Dim myRange As Range
  Dim myValue As Variant

  Dim bColumnGValueChanged As Boolean
  
  Dim iBaseRow As Integer
  Dim iRow As Integer
  
  Dim sCell As String
  
  'Get the Base Row for the 'Columnn G' Range (row that contains checkbox 1)
  Set myRange = Sheets(sSheetForColumn_G_RANGE).Range(sColumn_G_RANGE)
  iBaseRow = myRange.Row
  

  'Determine if there was a value changed in the 'Column G' range.
  'If the value was changed call the 'Change Event Handler'
  For iRow = LBound(ColumnGArray) To UBound(ColumnGArray)
    sCell = "G" & iRow
    myValue = Sheets(sSheetForColumn_G_RANGE).Range(sCell).Value
    
    If myValue <> ColumnGArray(iRow) Then
      'Debug.Print "ColumnGRangeCalculateEventHandler() on cell '" & sCell & "' at " & Now()
      'Debug.Print "Old=" & ColumnGArray(iRow) & "    New=" & myValue
      'Debug.Print
      ColumnGArray(iRow) = myValue
      Call ColumnGRangeChangeEventHandler(Sheets(sSheetForColumn_G_RANGE).Range(sCell))
    End If
  Next iRow
  
End Sub
  
  
Sub ShowAllCheckBoxes()

  Dim i As Integer
  
  Dim sCheckBoxName As String

  'Turn error checking off to prevent a run time error caused by a bad CheckBox name or missing CheckBox
  On Error Resume Next
  For i = 1 To 20
    sCheckBoxName = "CheckBox" & i
    Sheets(sSheetForColumn_G_RANGE).Shapes(sCheckBoxName).Visible = True
  Next i
  On Error GoTo 0

End Sub


Sub TraverseCheckBoxes()

  Dim r As Range

  Dim i As Integer
  
  Dim sCheckBoxName As String
  Dim sValue As String
  
  For Each r In Range(sColumn_G_RANGE)
  
    'Increment the CheckBox number
    'Create the CheckBox Name
    i = i + 1
    sCheckBoxName = "CheckBox" & i
    
    'Get the next value in Columnn G
    sValue = Trim(r.Text)
    
    'Debug.Print Format(i, "00  ") & r.Address(False, False) & "  " & r.Text
    
    'Turn error checking off to prevent a run time error caused by a bad CheckBox name or missing CheckBox
    'If there is a value in Column G:
    'a. Make the corresponding CheckBox visible
    '
    'If there is NO value in Column G:
    'a. Make the corresponding Checkbox visible
    'b. Uncheck the checkbox (must be visible for this to happen)
    'c. Make the corresponding Checkbox invisible
    On Error Resume Next
    If Len(sValue) > 0 Then
      Sheets(sSheetForColumn_G_RANGE).Shapes(sCheckBoxName).Visible = True
    Else
      Sheets(sSheetForColumn_G_RANGE).Shapes(sCheckBoxName).Visible = True
      Sheets(sSheetForColumn_G_RANGE).OLEObjects(sCheckBoxName).Object.Value = False
      Sheets(sSheetForColumn_G_RANGE).Shapes(sCheckBoxName).Visible = False
    End If
    On Error GoTo 0
    
  Next r

End Sub

Code in Module 'ModShapes'. This is needed if the 'CheckBox' names are not 'CheckBox1' thru 'CheckBox20' as stated in my previous post:

Option Explicit

Sub LoopThroughShapes()

  Dim Sh As Object
  Dim iCount As Integer
    
  For Each Sh In ActiveSheet.Shapes
  
    iCount = iCount + 1
    Debug.Print Format(iCount, "00  ") & "Shape Name = " & Sh.Name & "   Top = "; Sh.Top & "   Left = "; Sh.Left & "   Visible = " & Sh.Visible
  
  Next Sh
  
End Sub

Sub RenameShapesIfNecessary()
  'This renames Shapes as required
  
  Dim sOldName As String
  Dim sNewName As String
  
  'Edit the following two lines as required
  sOldName = "CheckBoxX"
  sNewName = "CheckBox1"
  
  ActiveSheet.Shapes(sOldName).Name = sNewName
End Sub

This is outstanding. The solution works perfectly and I appreciate the time you put into it. Many many thanks!