VBA code to add Constraints to my Worksheets_Calculate Macro

[JohnGow383]

Hi,

I'm posting this a new thread since it's changed topic. I was kindly given the below code from someone on this forum. It does what it says however, I need contraints added to it so it doesn't fire unless these conditions are satisfied. The current code is as follows:

Private Sub Worksheet_Calculate()

Dim Cell1 As Range, msg1 As String
Dim Cell2 As Range, msg2 As String
Dim Cell3 As Range, msg3 As String
Dim Cell4 As Range, msg4 As String

Set Cell1 = Range("H6"): msg1 = "WARNING!!! Please Check the LSFO Meter Reading!"
Set Cell2 = Range("H7"): msg2 = "WARNING!!! Please Check the LSMGO Meter Reading!"
Set Cell3 = Range("E3"): msg3 = "WARNING!!! Please Check the M/T Counter Reading!"
Set Cell4 = Range("I9"): msg4 = "WARNING!!! Please Check the Gas Counter Reading!"

With Range("H13:K14")
Select Case Cell1.Value
Case 0 To 200
.ClearContents
Case Else
.Value = msg1
MsgBox msg1
End Select
End With

With Range("H13:K14")
Select Case Cell2.Value
Case 0 To 200
.ClearContents
Case Else
.Value = msg2
MsgBox msg2
End Select
End With

With Range("H13:K14")
Select Case Cell3.Value
Case 0 To 82
.ClearContents
Case Else
.Value = msg3
MsgBox msg3
End Select
End With

With Range("H13:K14")
Select Case Cell4.Value
Case 0 To 400
.ClearContents
Case Else
.Value = msg4
MsgBox msg4
End Select
End With

End Sub

The code is looking at the calculated values in the trigger cells and displaying a warning message in merged cells "H13:K14" as well as a message box. I would like each trigger cell to be ignored if the following conditions are met.

Trigger Cells:
Cell1 = "H6" If C5 cell is blank to not fire
Cell2 = "H7" If C5 cell is blank to not fire
Cell3 = "E3" If C4 cell is blank to not fire
Cell4 = "I9" If C6 cell is blank to not fire

The calculation is between the above mentioned cells (C4, C5 & C6) and other cells. These are being cleared daily and new figures added. It's only when these cells are then populated that I want it to check that a wrong number has been entered and if so it triggers the warning message. With the cells blank it's triggering before any numbers are added.

Thanks

 

[JoeMo]

Untested. Replace the lines that start immediately after the Set Cell1.... block with the blocks below:

With Range("H13:K14")
    If Not IsEmpty(Range("C5")) Then
        Select Case Cell1.Value
        Case 0 To 200
        .ClearContents
        Case Else
        .Value = msg1
        MsgBox msg1
        End Select
    End If
End With

With Range("H13:K14")
    If Not IsEmpty(Range("C5")) Then
        Select Case Cell2.Value
        Case 0 To 200
        .ClearContents
        Case Else
        .Value = msg2
        MsgBox msg2
        End Select
    End If
End With

With Range("H13:K14")
    If Not IsEmpty(Range("C4")) Then
        Select Case Cell3.Value
        Case 0 To 82
        .ClearContents
        Case Else
        .Value = msg3
        MsgBox msg3
        End Select
    End If
End With

With Range("H13:K14")
    If Not IsEmpty(Range("C6")) Then
        Select Case Cell4.Value
        Case 0 To 400
        .ClearContents
        Case Else
        .Value = msg4
        MsgBox msg4
        End Select
    End If
End With

 

[Micron]

Not sure I understand all that and can't decipher if you're looking for 2 fixes or one. Re the calcuation taking place too early, could be that you're using the wrong event? Seems to me that you should be able to fix that by using WorkSheet_Change event - when data is changed in a cell? Or, less likely it seems, but maybe Selection_Change?

As an example of the change event and condensing that code, perhaps more like

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Range("H13:K14")) Is Nothing Then
'ignore all if change not in that or the appropriate range

For i = 1 To 4
   With Range("H13:K14")
      Select Case Cell & i.Value
          Case 0 To 200
              .ClearContents
          Case Else
              .Value = msg & i
      End Select
   End With
Next

If you still need to check particular cells even if using the change event, you might offset from the Target, but I'd say only if you're dealing with either a single row or column:
If Target.Offset(0, 1).Value > 0 'or similar test

or you might use
Select Case True
Case IsEmpty(Range("H6")), IsEmpty(Range("H7"))... <<just guessing you can do this rather than 1 per line

 

[JohnGow383]

Thanks so much this works!

With Range("H13:K14") If Not IsEmpty(Range("C5")) Then Select Case Cell1.Value Case 0 To 200 .ClearContents Case Else .Value = msg1 MsgBox msg1 End Select End If End With With Range("H13:K14") If Not IsEmpty(Range("C5")) Then Select Case Cell2.Value Case 0 To 200 .ClearContents Case Else .Value = msg2 MsgBox msg2 End Select End If End With With Range("H13:K14") If Not IsEmpty(Range("C4")) Then Select Case Cell3.Value Case 0 To 82 .ClearContents Case Else .Value = msg3 MsgBox msg3 End Select End If End With With Range("H13:K14") If Not IsEmpty(Range("C6")) Then Select Case Cell4.Value Case 0 To 400 .ClearContents Case Else .Value = msg4 MsgBox msg4 End Select End If End With

There is only one more statement I'd like to add and it's only for this part of the code

With Range("H13:K14")
    If Not IsEmpty(Range("C5")) Then
        Select Case Cell2.Value
        Case 0 To 200
        .ClearContents
        Case Else
        .Value = msg2
        MsgBox msg2
        End Select
    End If
End With

In addition to If Not IsEmpty(Range("C5")) Then can I also have it so merged cell ("J17:K18") = "LSMGO"
So I need an AND statement for C5 to be not blank AND ("J17:K18") = "LSMGO"
Sorry, I understand what I need I'm just hopeless with the syntax
Thanks so much, very much appreciated

 

[JohnGow383]

Thanks for your reply. Yeah I have tried using Worksheet_Change but because the the trigger cells contain formula, that doesn't work. I have a lot of Worksheet_Change macros within the spreadsheet too.

Not sure I understand all that and can't decipher if you're looking for 2 fixes or one. Re the calcuation taking place too early, could be that you're using the wrong event? Seems to me that you should be able to fix that by using WorkSheet_Change event - when data is changed in a cell? Or, less likely it seems, but maybe Selection_Change?

As an example of the change event and condensing that code, perhaps more like

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Range("H13:K14")) Is Nothing Then
'ignore all if change not in that or the appropriate range

For i = 1 To 4
   With Range("H13:K14")
      Select Case Cell & i.Value
          Case 0 To 200
              .ClearContents
          Case Else
              .Value = msg & i
      End Select
   End With
Next

If you still need to check particular cells even if using the change event, you might offset from the Target, but I'd say only if you're dealing with either a single row or column:
If Target.Offset(0, 1).Value > 0 'or similar test

or you might use
Select Case True
Case IsEmpty(Range("H6")), IsEmpty(Range("H7"))... <<just guessing you can do this rather than 1 per line

 

[JoeMo]

Thanks so much this works!

There is only one more statement I'd like to add and it's only for this part of the code

With Range("H13:K14")
    If Not IsEmpty(Range("C5")) Then
        Select Case Cell2.Value
        Case 0 To 200
        .ClearContents
        Case Else
        .Value = msg2
        MsgBox msg2
        End Select
    End If
End With

In addition to If Not IsEmpty(Range("C5")) Then can I also have it so merged cell ("J17:K18") = "LSMGO"
So I need an AND statement for C5 to be not blank AND ("J17:K18") = "LSMGO"
Sorry, I understand what I need I'm just hopeless with the syntax
Thanks so much, very much appreciated

You are welcome. For your additional constraint, replace the With-End With block with this one:

With Range("H13:K14")
    If Not IsEmpty(Range("C5")) And Range("J17") = "LSMGO" Then
        Select Case Cell2.Value
        Case 0 To 200
        .ClearContents
        Case Else
        .Value = msg2
        MsgBox msg1
        End Select
    End If
End With

 

[JohnGow383]

You are welcome. For your additional constraint, replace the With-End With block with this one:

With Range("H13:K14")
    If Not IsEmpty(Range("C5")) And Range("J17") = "LSMGO" Then
        Select Case Cell2.Value
        Case 0 To 200
        .ClearContents
        Case Else
        .Value = msg2
        MsgBox msg1
        End Select
    End If
End With

Thanks. That works perfectly. I nearly had it right, but I'd addressed J17 as ("J17:K18").

Thanks again for your assitance. It has given me some understanding how to expand this. Very much appreciated.

 

[JoeMo]

Thanks. That works perfectly. I nearly had it right, but I'd addressed J17 as ("J17:K18").

Thanks again for your assitance. It has given me some understanding how to expand this. Very much appreciated.

You are welcome - thanks for the reply.