Help With Looping Macro

Sorry 6StringJazzer for the mistake above will read the rules today.

Sorry my post wasn't more detailed. The VBA above i originally wrote works perfect but only works for row 7. I need the above VBA to do the same for row 8 if there's something written on cell "B8" and the same on "B9" ect. I've attached the forum which the code is running on. So you may get a better understanding.

However, note that is not a best practice from a user interface standpoint. If there is more than one blank cell, you are going to make the user run this over and over again. Instead you should notify him of all blank cells in one go. What is wrong with the version you started with?

Explain in plain text what is the purpose of your procedure …

Originally Posted by Marc L

Explain in plain text what is the purpose of your procedure …

When someone goes in the form and writes something on the first cell which will be “B7” or “B8” or “B9” ect and tries to save. It will prompt them if something is missing in the entire row and indicate which cell they left blank. So for example they write something on “B10” and forgot to input something on “J8” when they go to hit save it prompt them they didn’t fill out “J8”. The code above works perfectly but for only row 7 I need the code to loop and go to the next cell down the check if something was written on “B8” and perform all the checks required as it happen ong row 7.

I could simply copy and paste the code 100 times and set the ranges per row but trying do the use best efficiency and not have a VBA code 10,000 lines long and possibly prompt me it’s s to long. Would just rather see 15 lines of code and looping.

Which columns may be blank ?

If there is a huge number of rows to check, the control may stop at the first row with any missing entry …

How about

Private Sub Workbook_BeforeSave(ByVal SaveasUI As Boolean, Cancel As Boolean)
   Dim Cl As Range
   Dim Flg As Boolean
   
   For Each Cl In Range("B7", Range("B" & Rows.Count).End(xlUp))
      If Not IsEmpty(Cl) Then
         If Application.CountA(Cl.Offset(, 1).Resize(, 13)) <> 13 Then
            Flg = True
            MsgBox "Please fill in blank cells " & Cl.Offset(, 1).Resize(, 13).SpecialCells(xlBlanks).Address(0, 0)
         End If
         If Application.CountA(Cl.Offset(, 15).Resize(, 9)) = 0 Then
            Flg = True
            MsgBox ("Please Fill In a Division For Cells Between sDiv")
         End If
         If Application.CountA(Cl.Offset(, 23).Resize(, 3)) <> 3 Then
            Flg = True
            MsgBox "Please fill in blank cells " & Cl.Offset(, 23).Resize(, 3).SpecialCells(xlBlanks).Address(0, 0)
         End If
      End If
      If Flg Then Cancel = True
   Next Cl
   Rows("7:119").EntireRow.AutoFit
End Sub

Originally Posted by Fluff13

How about

Private Sub Workbook_BeforeSave(ByVal SaveasUI As Boolean, Cancel As Boolean)
   Dim Cl As Range
   Dim Flg As Boolean
   
   For Each Cl In Range("B7", Range("B" & Rows.Count).End(xlUp))
      If Not IsEmpty(Cl) Then
         If Application.CountA(Cl.Offset(, 1).Resize(, 13)) <> 13 Then
            Flg = True
            MsgBox "Please fill in blank cells " & Cl.Offset(, 1).Resize(, 13).SpecialCells(xlBlanks).Address(0, 0)
         End If
         If Application.CountA(Cl.Offset(, 15).Resize(, 9)) = 0 Then
            Flg = True
            MsgBox ("Please Fill In a Division For Cells Between sDiv")
         End If
         If Application.CountA(Cl.Offset(, 23).Resize(, 3)) <> 3 Then
            Flg = True
            MsgBox "Please fill in blank cells " & Cl.Offset(, 23).Resize(, 3).SpecialCells(xlBlanks).Address(0, 0)
         End If
      End If
      If Flg Then Cancel = True
   Next Cl
   Rows("7:119").EntireRow.AutoFit
End Sub

Fluff13 thank you so much your code worked I just altered it a bit since the offset was off by 1 cell for the divisions in range "p7:x7" and was still letting me save it if something wasn't marked in those ranges. Below is the altered code and works perfectly thank you again.

Private Sub Workbook_BeforeSave(ByVal SaveasUI As Boolean, Cancel As Boolean)
   Dim Cl As Range
   Dim Flg As Boolean
   
   For Each Cl In Range("B7", Range("B" & Rows.Count).End(xlUp))
      If Not IsEmpty(Cl) Then
         If Application.CountA(Cl.Offset(, 1).Resize(, 13)) <> 13 Then
            Flg = True
            MsgBox "Please fill in blank cells " & Cl.Offset(, 1).Resize(, 13).SpecialCells(xlBlanks).Address(0, 0)
         End If
         If WorksheetFunction.CountA(Cl.Offset(, 14).Resize(, 9)) = 0 Then
            MsgBox "Please Fill In a Division For Cells Between " & Cl.Offset(, 14).Resize(, 9).SpecialCells(xlBlanks).Address(0, 0)
            Cancel = True
         End If
         If Application.CountA(Cl.Offset(, 23).Resize(, 3)) <> 3 Then
            Flg = True
            MsgBox "Please fill in blank cells " & Cl.Offset(, 23).Resize(, 3).SpecialCells(xlBlanks).Address(0, 0)
         End If
      End If
      If Flg Then Cancel = True
   Next Cl
   Rows("7:119").EntireRow.AutoFit
End Sub

Glad to help & thanks for the feedback