View Single Post
  #15   Report Post  
Posted to microsoft.public.excel.programming
Claus Busch Claus Busch is offline
external usenet poster
 
Posts: 3,872
Default Loop not quite working correctly

Hi Howard,

Am Wed, 27 May 2015 02:44:47 -0700 (PDT) schrieb L. Howard:

Set OneRng = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
myCnt = Application.CountA(OneRng)


the above does not work reliable. You have to set the range fix as he
should be filled. Also does not work SpecialCells method under the last
cell. And you don't have to count blanks because "Diff" is the count of
the blank cells.
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("A200")) = 0 Then Range("A200") = "End"

Diff = 200 - myCnt
If Not ThisWorkbook.Saved Then
If Diff 0 Then

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"

Cancel = True
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