Vba formula help

[EwEn999]

Hi all, I'm looking for help in trying to achieve the following. If any of the values in a range is >1, then use the corresponding name from column A.

The comments in the code below will hopefully explain what I'm hoping for.

I've also created a table for reference.

Thanks in advance

Sub ErrorMsg1()

    Dim OfficersName As String
    Dim Totals As Integer
    
    'if any value in the range b27:h27 is >1, use the officer's name in a27 in the corresponding msgbox
    'if any value in the range b31:h31 is >1, use the officer's name in a31 in the corresponding msgbox
    'if any value in the range b35:h35 is >1, use the officer's name in a35 in the corresponding msgbox
    'if any value in the range b39:h39 is >1, use the officer's name in a39 in the corresponding msgbox
    'if any value in the range b43:h43 is >1, use the officer's name in a43 in the corresponding msgbox
        
    Totals = Range("B27").Value
    OfficersName = Range("A27")
    
    If Totals > 1 Then
        MsgBox OfficersName & " Has been scheduled on 2 or more sites." & vbNewLine & "Please Rectify." & vbNewLine & _
        "Press OK to acknowledge.", vbExclamation + vbOKOnly, "Error"
    Else
        Exit Sub
    End If
    
End Sub

	A	B	C	D	E	F	G	H
		Mon	Tue	Wed	Thu	Fri	Sat	Sun
24
25
26
27	Officer 1
28
29
30
31	Officer 2
32
33
34
35	Officer 3
36
37
38
39	Officer 4
40
41
42
43	Officer 5

<tbody>
</tbody>

 

[Fluff]

How about

Sub EwEn999()
   Dim i As Long
   
   For i = 27 To 43 Step 4
      If Application.CountIf(Range("B" & i).Resize(, 7), ">1") Then
         MsgBox Range("A" & i) & " Has been scheduled on 2 or more sites." & vbNewLine & "Please Rectify." & vbNewLine & _
        "Press OK to acknowledge.", vbExclamation + vbOKOnly, "Error"
      End If
   Next i
End Sub

 

[EwEn999]

How about

Sub EwEn999()
   Dim i As Long
   
   For i = 27 To 43 Step 4
      If Application.CountIf(Range("B" & i).Resize(, 7), ">1") Then
         MsgBox Range("A" & i) & " Has been scheduled on 2 or more sites." & vbNewLine & "Please Rectify." & vbNewLine & _
        "Press OK to acknowledge.", vbExclamation + vbOKOnly, "Error"
      End If
   Next i
End Sub

This looks really good, I’ll try it out in a bit

 

[EwEn999]

This has worked perfectly, thank you.

To improve the msgbox statement for the end user, would it possible to add the day (and eventually the date) the error occurred?

Also if i wanted to have another logical test, do i just need to change the ">1" part of the below code, even if it need to reference another cell?

[COLOR=#574123]If Application.CountIf(Range("B" & i).Resize(, 7), ">1") Then[/COLOR]

Apologies for all the questions, I'm still a rookie when it comes to coding.

 

[Fluff]

how about

Sub EwEn999()
   Dim i As Long, j As Long
   Dim Msg As String
   
   For i = 27 To 43 Step 4
      If Application.CountIf(Range("B" & i).Resize(, 7), ">1") Then
         For j = 1 To 7
            If Cells(i, j) > 1 Then
               If Msg = "" Then Msg = Cells(23, j) Else Msg = Msg & ", " & Cells(23, j)
            End If
         Next j
         MsgBox Range("A" & i) & " Has been scheduled on 2 or more sites. On " & Msg & vbNewLine & "Please Rectify." & vbNewLine & _
        "Press OK to acknowledge.", vbExclamation + vbOKOnly, "Error"
        Msg = ""
      End If
   Next i
End Sub

For the other test, it depends on what you want to check

 

[EwEn999]

The other test is if ((0.9<=b27>=1) and (0.7<=c27>=0.8))

 

[Fluff]

Before we deal with the extra checks, does the code I've supplied do what you want for the message box?

 

[EwEn999]

It looks like it will, I won’t be able to test it until later on when I get into work.

 

[Fluff]

Give this a try

Sub EwEn999()
   Dim i As Long, j As Long
   Dim Msg As String
   
   For i = 27 To 43 Step 4
      If Range("B" & i) >= 0.9 And Range("B" & i) <= 1 And Range("C" & i) >= 0.7 And Range("C" & i) <= 0.8 Then
         If Application.CountIf(Range("B" & i).Resize(, 7), ">1") Then
            For j = 1 To 7
               If Cells(i, j) > 1 Then
                  If Msg = "" Then Msg = Cells(23, j) Else Msg = Msg & ", " & Cells(23, j)
               End If
            Next j
            MsgBox Range("A" & i) & " Has been scheduled on 2 or more sites. On " & Msg & vbNewLine & "Please Rectify." & vbNewLine & _
           "Press OK to acknowledge.", vbExclamation + vbOKOnly, "Error"
           Msg = ""
         End If
      End If
   Next i
End Sub

 

[EwEn999]

how about

Sub EwEn999()
   Dim i As Long, j As Long
   Dim Msg As String
   
   For i = 27 To 43 Step 4
      If Application.CountIf(Range("B" & i).Resize(, 7), ">1") Then
         For j = 1 To 7
            If Cells(i, j) > 1 Then
               If Msg = "" Then Msg = Cells(23, j) Else Msg = Msg & ", " & Cells(23, j)
            End If
         Next j
         MsgBox Range("A" & i) & " Has been scheduled on 2 or more sites. On " & Msg & vbNewLine & "Please Rectify." & vbNewLine & _
        "Press OK to acknowledge.", vbExclamation + vbOKOnly, "Error"
        Msg = ""
      End If
   Next i
End Sub

For the other test, it depends on what you want to check

This works great. Thank You @Fluff