Loop not quite working correctly
Hi again,
Am Wed, 27 May 2015 14:01:24 +0200 schrieb Claus Busch:
MsgBox "Cells A1 to A" & myCnt & " " & _
" must have values before " _
& vbCr & " the workbook is closed or saved!" _
& vbCr & vbCr & _
" " & Diff & _
" cells are empty!", vbExclamation, "Blank Cells Alert"
the values in the MsgBox are wrong.
Try:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As
Boolean)
Dim myCnt As Long, Diff As Long
Dim OneRng As Range, rngC As Range, sBlanks$, vMsg
Set OneRng = Range("A1:A200")
myCnt = Application.CountA(OneRng)
If Len(Range("A201")) = 0 Then Range("A201") = "End"
Diff = 200 - myCnt
If Not ThisWorkbook.Saved Then
If Diff 0 Then
Cancel = True
MsgBox "Cells A1 to A200 " & _
" must have values before " _
& vbCr & " the workbook is closed or saved!" _
& vbCr & vbCr & _
" " & Diff & _
" cells are empty!", vbExclamation, "Blank Cells Alert"
sBlanks = OneRng.SpecialCells(xlCellTypeBlanks).Address(0, 0)
sBlanks = Join(Split(sBlanks, ","), Chr(10))
vMsg = "Blanks cells a" & vbLf & vbLf & sBlanks
End If
End If
MsgBox vMsg, vbInformation
End Sub
Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional
|