Vba formula help

EwEn999

New Member
Joined
Dec 3, 2018
Messages
27
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

Code:
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

[TABLE="class: grid, width: 500, align: left"]
<tbody>[TR]
[TD="align: center"][/TD]
[TD="align: center"]A[/TD]
[TD="align: center"]B[/TD]
[TD="align: center"]C[/TD]
[TD="align: center"]D[/TD]
[TD="align: center"]E[/TD]
[TD="align: center"]F[/TD]
[TD="align: center"]G[/TD]
[TD="align: center"]H[/TD]
[/TR]
[TR]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"]Mon[/TD]
[TD="align: center"]Tue[/TD]
[TD="align: center"]Wed[/TD]
[TD="align: center"]Thu[/TD]
[TD="align: center"]Fri[/TD]
[TD="align: center"]Sat[/TD]
[TD="align: center"]Sun[/TD]
[/TR]
[TR]
[TD="align: center"]24[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]25[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]26[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]27[/TD]
[TD="align: center"]Officer 1[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]28[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]29[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]30[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]31[/TD]
[TD="align: center"]Officer 2[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]32[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]33[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]34[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]35[/TD]
[TD="align: center"]Officer 3[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]36[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]37[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]38[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]39[/TD]
[TD="align: center"]Officer 4[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]40[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]41[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]42[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]43[/TD]
[TD="align: center"]Officer 5[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
</tbody>[/TABLE]
 

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.
How about
Code:
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
 
Upvote 0
How about
Code:
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
 
Upvote 0
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?
Code:
[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.
 
Upvote 0
how about
Code:
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
 
Upvote 0
Before we deal with the extra checks, does the code I've supplied do what you want for the message box?
 
Upvote 0
It looks like it will, I won’t be able to test it until later on when I get into work.
 
Last edited by a moderator:
Upvote 0
Give this a try
Code:
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
 
Upvote 0
how about
Code:
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
 
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,176
Members
453,021
Latest member
Justyna P

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top