Disable save based on condition

Question

Hi the macro below works excellent the only thing is that it is not letting me save even if there is no data or data that matches the criteria of less 120 characters in the columns with character count criterias (L to O) Thanks Vish --X-- Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

  Dim bad As Range, n As Integer
  With Worksheets("Questions")
      For Each ocell In .Range("D2:D" & .Range("D50000").End(xlUp).Row)
          n = 0
          If ocell.Value <> "Sony" Then GoTo NG
          n = 6
          If ocell.Offset(0, 6).Value <> "RESPONSE_OPTIONS" And ocell.Offset(0, 6).Value <> "NUMBER OF" Then GoTo NG
          n = 7
          If ocell.Offset(0, 7).Value <> "SI" And ocell.Offset(0, 7).Value <> "POP" Then GoTo NG
          n = 14
          If ocell.Offset(0, 14).Value <> "0" And ocell.Offset(0, 14).Value <> "1" Then GoTo NG
          n = 15
          If ocell.Offset(0, 15).Value <> "0" And ocell.Offset(0, 15).Value <> "1" Then GoTo NG
          n = 16
          If ocell.Offset(0, 16).Value <> "0" And ocell.Offset(0, 16).Value <> "1" Then GoTo NG
          n = 17
          If ocell.Offset(0, 17).Value <> "0" And ocell.Offset(0, 17).Value <> "1" Then GoTo NG
          Dim GotOne As Boolean
          For i = 12 To 15    'L to O
              If Len(Cells(ocell.Row, i).Value) > 120 Then    'turn it italic
                  Cells(ocell.Row, i).Font.Bold = True
              Else
                  Cells(ocell.Row, i).Font.Bold = False
                  If GotOne Then Set bad = Union(bad, Cells(ocell.Row, i)) Else Set bad = Cells(ocell.Row, i)
                  GotOne = True
              End If
          Next
      Next
  End With
  then, before the Exit Sub and after the End With:
  If GotOne Then MsgBox "The Selected cells have more than 120 characters. Please fix."
  bad.Select
  Cancel = True
  Exit Sub

NG:

  Cancel = True
  ocell.Offset(0, n).Select
  MsgBox "You can't save until you correct the format of the selected cell", vbOKOnly

End Sub

Answer

Sorry. Try this: Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

 Dim bad As Range, n As Integer
 With Worksheets("Questions")
     For Each ocell In .Range("D2:D" & .Range("D50000").End(xlUp).Row)
         n = 0
         If ocell.Value <> "Sony" Then GoTo NG
         n = 6
         If ocell.Offset(0, 6).Value <> "RESPONSE_OPTIONS" And ocell.Offset(0, 6).Value <> "NUMBER OF" Then GoTo NG
         n = 7
         If ocell.Offset(0, 7).Value <> "SI" And ocell.Offset(0, 7).Value <> "POP" Then GoTo NG
         n = 14
         If ocell.Offset(0, 14).Value <> "0" And ocell.Offset(0, 14).Value <> "1" Then GoTo NG
         n = 15
         If ocell.Offset(0, 15).Value <> "0" And ocell.Offset(0, 15).Value <> "1" Then GoTo NG
         n = 16
         If ocell.Offset(0, 16).Value <> "0" And ocell.Offset(0, 16).Value <> "1" Then GoTo NG
         n = 17
         If ocell.Offset(0, 17).Value <> "0" And ocell.Offset(0, 17).Value <> "1" Then GoTo NG
         Dim GotOne As Boolean
         For i = 12 To 15    'L to O
             If Len(Cells(ocell.Row, i).Value) > 120 Then    'turn it italic
                 Cells(ocell.Row, i).Font.Bold = True
             Else
                 Cells(ocell.Row, i).Font.Bold = False
                 If GotOne Then Set bad = Union(bad, Cells(ocell.Row, i)) Else Set bad = Cells(ocell.Row, i)
                 GotOne = True
             End If
         Next
     Next
 End With
 then, before the Exit Sub and after the End With:
 If GotOne Then 
    MsgBox "The Selected cells have more than 120 characters. Please fix."
    bad.Select
    Cancel = True
 End If
 Exit Sub

NG:

 Cancel = True
 ocell.Offset(0, n).Select
 MsgBox "You can't save until you correct the format of the selected cell", vbOKOnly

End Sub