Good day guys
Happy to be here
I posted this same question on a different forum but unfortunately did not get sufficient help to resolve the issue.
My experience with VBA is still very limited and would appreciate any assistance.
The project I have been working on basically works like this:
- The user double clicks on any cell within a checkboard layout.
- This opens up a form with a number of options, such as Conditions, Performance, Clear Cell & Clear sheet.
- Clicking on Performance opens up another form (form3) with a large number of tick box options. Each of these options is linked to a certain rating and the chosen options add up to a final Performance rating out of a 100.
- Ticking boxes and submitting the form then also adds the value 1 to a Month End datasheet under the name of the ticked parameter.
My problem comes in when using the "Clear Cell" option. This function on form1 effectively clears any formatting and values that were placed in that specific cell due to the chosen Performance tick boxes and the final rating value.
The issue is: How do I get the "Clear Cell" button to also undo the + 1 value added under each specific tick under Month End data?
I can't simply subtract 1 from every box under Month End, as other boxes may have been ticked on the checkboard layout.
Only the values added due to the Performance tick boxes marked for that specific cell must be undone.
Please assist.
Please find attached the code for the submit button of Form3 (Performance) and the current "Clear Cell" code below it.
Dim Roofloc As String
Dim Ribloc As String
PRoofRating = (Worksheets("Rating Factors").Range("T3").Value - (BordWRNumber + BordWINumber + GridNumber + StitNumber + GutteringNumber + ArielNumber + RMDINumber + RMDSNumber + RMDMNumber + RMDGNumber + BrowNumber + BarNumber + BleedNumber + FaultNumber + DykeNumber + BRNumber + RENumber)) / (Worksheets("Rating Factors").Range("T3").Value) * 100
PRibsideRating = (Worksheets("Rating Factors").Range("T21").Value - (SupNumber + ArealCNumber + BarRNumber + BarriNumber + RERNumber)) / (Worksheets("Rating Factors").Range("T21").Value) * 100
' Roof Rating Value can not be less than 0
If PRoofRating < 0 Then
PRoofRating = 0
End If
' Ribside Rating Value can not be less than 0
If PRibsideRating < 0 Then
PRibsideRating = 0
End If
' Changes active cell colour based on rating
If (PRoofRating <= PRibsideRating) Then
If ((PRoofRating <= 100) And (PRoofRating >= 95)) Then
ActiveCell.Interior.Color = RGB(146, 208, 80)
End If
If ((PRoofRating <= 94) And (PRoofRating >= 80)) Then
ActiveCell.Interior.Color = RGB(255, 192, 0)
End If
If ((PRoofRating <= 79) And (PRoofRating >= 0)) Then
ActiveCell.Interior.Color = RGB(255, 51, 0)
End If
End If
If (PRibsideRating <= PRoofRating) Then
If ((PRibsideRating <= 100) And (PRibsideRating >= 95)) Then
ActiveCell.Interior.Color = RGB(146, 208, 80)
End If
If ((PRibsideRating <= 94) And (PRibsideRating >= 80)) Then
ActiveCell.Interior.Color = RGB(255, 192, 0)
End If
If ((PRibsideRating <= 79) And (PRibsideRating >= 0)) Then
ActiveCell.Interior.Color = RGB(255, 51, 0)
End If
End If
'Use location in the Rating Output sheet
loc = ActiveCell.Address()
Roofloc = Range(loc).Offset(44).Address
Ribloc = Range(loc).Offset(66).Address
Worksheets("Rating Output").Range(Roofloc).Value = PRoofRating
Worksheets("Rating Output").Range(Ribloc).Value = PRibsideRating
' Add one to Month End for each parameter
If BordWRBox1.Value = True Then
Worksheets("Month End").Range("N6").Value = Worksheets("Month End").Range("N6").Value + 1
End If
If BordWRBox2.Value = True Then
Worksheets("Month End").Range("M6").Value = Worksheets("Month End").Range("M6").Value + 1
End If
If BordWIBox1.Value = True Then
Worksheets("Month End").Range("P6").Value = Worksheets("Month End").Range("P6").Value + 1
End If
If BordWIBox2.Value = True Then
Worksheets("Month End").Range("O6").Value = Worksheets("Month End").Range("O6").Value + 1
End If
If FaultBox1.Value = True Then
Worksheets("Month End").Range("AL6").Value = Worksheets("Month End").Range("AL6").Value + 1
End If
If FaultBox2.Value = True Then
Worksheets("Month End").Range("AK6").Value = Worksheets("Month End").Range("AK6").Value + 1
End If
If GridBox1.Value = True Then
Worksheets("Month End").Range("R6").Value = Worksheets("Month End").Range("R6").Value + 1
End If
If GridBox2.Value = True Then
Worksheets("Month End").Range("Q6").Value = Worksheets("Month End").Range("Q6").Value + 1
End If
If GutteringBox1.Value = True Then
Worksheets("Month End").Range("V6").Value = Worksheets("Month End").Range("V6").Value + 1
End If
If GutteringBox2.Value = True Then
Worksheets("Month End").Range("U6").Value = Worksheets("Month End").Range("U6").Value + 1
End If
If RMDGBox1.Value = True Then
Worksheets("Month End").Range("AF6").Value = Worksheets("Month End").Range("AF6").Value + 1
End If
If RMDGBox2.Value = True Then
Worksheets("Month End").Range("AE6").Value = Worksheets("Month End").Range("AE6").Value + 1
End If
If StitBox1.Value = True Then
Worksheets("Month End").Range("T6").Value = Worksheets("Month End").Range("T6").Value + 1
End If
If StitBox2.Value = True Then
Worksheets("Month End").Range("S6").Value = Worksheets("Month End").Range("S6").Value + 1
End If
If ArealBox1.Value = True Then
Worksheets("Month End").Range("X6").Value = Worksheets("Month End").Range("X6").Value + 1
End If
If ArealBox2.Value = True Then
Worksheets("Month End").Range("W6").Value = Worksheets("Month End").Range("W6").Value + 1
End If
If RMDIBox1.Value = True Then
Worksheets("Month End").Range("Z6").Value = Worksheets("Month End").Range("Z6").Value + 1
End If
If RMDIBox2.Value = True Then
Worksheets("Month End").Range("Y6").Value = Worksheets("Month End").Range("Y6").Value + 1
End If
If RMDSBox1.Value = True Then
Worksheets("Month End").Range("AB6").Value = Worksheets("Month End").Range("AB6").Value + 1
End If
If RMDSBox2.Value = True Then
Worksheets("Month End").Range("AA6").Value = Worksheets("Month End").Range("AA6").Value + 1
End If
If RMDMBox1.Value = True Then
Worksheets("Month End").Range("AD6").Value = Worksheets("Month End").Range("AD6").Value + 1
End If
If RMDMBox2.Value = True Then
Worksheets("Month End").Range("AC6").Value = Worksheets("Month End").Range("AC6").Value + 1
End If
If BrowBox1.Value = True Then
Worksheets("Month End").Range("AH6").Value = Worksheets("Month End").Range("AH6").Value + 1
End If
If BrowBox2.Value = True Then
Worksheets("Month End").Range("AG6").Value = Worksheets("Month End").Range("AG6").Value + 1
End If
If BleedBox1.Value = True Then
Worksheets("Month End").Range("AJ6").Value = Worksheets("Month End").Range("AJ6").Value + 1
End If
If BleedBox2.Value = True Then
Worksheets("Month End").Range("AL6").Value = Worksheets("Month End").Range("AL6").Value + 1
End If
If DykeBox1.Value = True Then
Worksheets("Month End").Range("AN6").Value = Worksheets("Month End").Range("AN6").Value + 1
End If
If DykeBox2.Value = True Then
Worksheets("Month End").Range("AM6").Value = Worksheets("Month End").Range("AM6").Value + 1
End If
If BRBox1.Value = True Then
Worksheets("Month End").Range("AP6").Value = Worksheets("Month End").Range("AP6").Value + 1
End If
If BRBox2.Value = True Then
Worksheets("Month End").Range("AO6").Value = Worksheets("Month End").Range("AO6").Value + 1
End If
If REBox1.Value = True Then
Worksheets("Month End").Range("AR6").Value = Worksheets("Month End").Range("AR6").Value + 1
End If
If REBox2.Value = True Then
Worksheets("Month End").Range("AQ6").Value = Worksheets("Month End").Range("AQ6").Value + 1
End If
If SupBox1.Value = True Then
Worksheets("Month End").Range("AU6").Value = Worksheets("Month End").Range("AU6").Value + 1
End If
If SupBox2.Value = True Then
Worksheets("Month End").Range("AT6").Value = Worksheets("Month End").Range("AT6").Value + 1
End If
If ArealCBox1.Value = True Then
Worksheets("Month End").Range("AW6").Value = Worksheets("Month End").Range("AW6").Value + 1
End If
If ArealCBox2.Value = True Then
Worksheets("Month End").Range("AV6").Value = Worksheets("Month End").Range("AV6").Value + 1
End If
If BarriBox1.Value = True Then
Worksheets("Month End").Range("AY6").Value = Worksheets("Month End").Range("AY6").Value + 1
End If
If BarriBox2.Value = True Then
Worksheets("Month End").Range("AX6").Value = Worksheets("Month End").Range("AX6").Value + 1
End If
If RERBox1.Value = True Then
Worksheets("Month End").Range("BA6").Value = Worksheets("Month End").Range("BA6").Value + 1
End If
If RERBox2.Value = True Then
Worksheets("Month End").Range("AZ6").Value = Worksheets("Month End").Range("AZ6").Value + 1
End If
Unload Form3
Display More
The code at the bottom of the above-written code adds the value 1 to the specific month end cell.
Private Sub ClearBut_Click()
loc = ActiveCell.Address
ActiveCell.Value = ""
ActiveCell.Interior.ColorIndex = 2
Worksheets("Rating Output").Range(loc).Value = ""
Ribloc = Range(loc).Offset(22).Address
Worksheets("Rating Output").Range(Ribloc).Value = ""
PRoofloc = Range(loc).Offset(44).Address
Worksheets("Rating Output").Range(PRoofloc).Value = ""
PRibloc = Range(loc).Offset(66).Address
Worksheets("Rating Output").Range(PRibloc).Value = ""
Display More
The above is the current code for the "Clear Cell" button on form1. As you can see, only code for other features is currently present and nothing to solve the issue stated above.
Simply undoing form3's input into month-end for a specific cell would have been the dream.
Any help would be appreciated.
Thanks in advance.
Link to other thread: https://www.excelforum.com/exc…bmission.html#post5460158
Kind Regards