jeudi 15 avril 2021

Excel VBA Checkbox - Checking and Unchecking By Itself When Running Click Code

I have a checkbox on each row in a protected worksheet in column Q. This checkbox when checked or unchecked will run the code below.

When I check the checkbox I want it to

  • unprotect the sheet
  • unlock the cell in column R (beside the checkbox)
  • change the cell background colour to white
  • hold the cell value
  • clear the formula
  • protect the sheet

When I uncheck the checkbox I want it to

  • unprotect the sheet
  • change the cell background colour to grey
  • put a formula in the cell
  • lock the cell
  • protect the sheet

For some reason when I check the checkbox (from being unchecked) the code runs and for some reason the checkbox reverts back to being unchecked. The opposite happens if the checkbox is originally checked and I uncheck it, the code runs and for some reason the checkbox reverts back to being checked. My code is not unchecking or checking the checkbox.

Can someone please help me figure out why the checkbox is changing after I check or uncheck it?

Sub PartQuantitiesCheckBox_Click()

    Dim sCheckboxName, sCheckboxValue, sCheckboxChecked, sDS1BuildRange As String
    Dim iCurrentRow As Integer

    sCheckboxName = Application.Caller

    ' If this returns 1 then the checkbox was checked and we clicked it to uncheck it.
    sCheckboxValue = ActiveSheet.Shapes(sCheckboxName).ControlFormat.Value

    If sCheckboxValue = "1" Then
        sCheckboxChecked = "False"
        MsgBox ("sCheckboxChecked = False")
    Else
        sCheckboxChecked = "True"
        MsgBox ("sCheckboxChecked = True")
    End If

    ' The checkbox name is prefaced with "cbPartQtyNeeded" followed by the row number (eg. cbPartQtyNeeded4).
    ' Strip the row number out of the checkbox name.
    iCurrentRow = Mid(sCheckboxName, 16, Len(sCheckboxName) - 15)
    sDS1BuildRange = "R" & iCurrentRow

    ActiveSheet.Unprotect

    If sCheckboxChecked = "False" Then
     
        Range(sDS1BuildRange).Select
        With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorDark1
            .TintAndShade = -0.149998474074526
            .PatternTintAndShade = 0
        End With
    
        Range(sDS1BuildRange).Formula = "=IFERROR(IF($P" & iCurrentRow & "*'Cover Sheet'!$M$8=0,"""",$P" & iCurrentRow & "*'Cover Sheet'!$M$8),"""")"
        Range(sDS1BuildRange).Locked = True

    Else

        Range(sDS1BuildRange).Locked = False
        Range(sDS1BuildRange).Select
        With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorDark1
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With

        sValue = Range(sDS1BuildRange).Value
        Range(sDS1BuildRange).Formula = ""
        Range(sDS1BuildRange).Value = sValue
         
    End If

    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True

End Sub



Aucun commentaire:

Enregistrer un commentaire