mardi 1 novembre 2016

How to prevent macro from unchecking checkboxes?

When I run the following macro twice it clears all checkboxes in my sheet. The macro works otherwise--I want to aggregate a total score based on compliance at 0-25-50-75-100% levels--but want the checkboxes to stay checked until manually unchecked. Each checkbox is linked to the cell that contains it. The coding I'm using (and I'm a beginner, so it may not be optimized) is as follows:

Sub DetermineCompliance()

Dim ComplianceTotal As Long

'Sums all 0% Cells
For Each CCell In Range("C3:C45")
    If CCell.Value = True Then
    CCell.Value = 0
    Else: CCell.Value = 0

    End If

Next CCell


'Sums all 25% Cells
For Each DCell In Range("D3:D45")
    If DCell.Value = True Then
    DCell.Value = 25
    Else: DCell.Value = 0

    End If

Next DCell


'Sums all 50% Cells
For Each ECell In Range("E3:E45")
    If ECell.Value = True Then
    ECell.Value = 50
    Else: ECell.Value = 0

    End If

Next ECell


'Sums all 75% Cells
For Each FCell In Range("F3:F45")
    If FCell.Value = True Then
    FCell.Value = 75
    Else: FCell.Value = 0

    End If

Next FCell


'Sums all 100% Cells
For Each GCell In Range("G3:G45")
    If GCell.Value = True Then
    GCell.Value = 100
    Else: GCell.Value = 0

    End If

Next GCell


Dim General As Long
Dim SAO As Long
Dim EA As Long
Dim Challenge As Long
Dim Misuse As Long


General = Application.Sum(Range("c3:g3"))
SAO = Application.Sum(Range("c5:g21"))
EA = Application.Sum(Range("c23:g32"))
Challenge = Application.Sum(Range("c34:g43"))
Misuse = Application.Sum(Range("c45:g45"))

ThisWorkbook.Sheets("Sheet1").Range("B2") = General
ThisWorkbook.Sheets("Sheet1").Range("C2") = SAO
ThisWorkbook.Sheets("Sheet1").Range("D2") = EA
ThisWorkbook.Sheets("Sheet1").Range("e2") = Challenge
ThisWorkbook.Sheets("Sheet1").Range("f2") = Misuse

Thanks in advance for your help!




Aucun commentaire:

Enregistrer un commentaire