Loop not quite working correctly
 

Want to list the cell address in range OneRng of each blank.

As is, it list the first blank cell address only, but for as many times as there are cells in OneRng.

Thanks.
Howard


Sub OneRng_List_Blanks()

Dim c As Range, Rng As Range
Dim cBlnk$, sMsg$, vDataOut$
Dim blnkFnd As Boolean
Dim i As Long

Dim OneRng As Range, c As Range
Set OneRng = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)

For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
'For Each c In OneRng

Set Rng = OneRng.Find(What:="", _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByColumns)
If Not Rng Is Nothing Then
blnkFnd = True

cBlnk = cBlnk & " " & Rng.Address

End If

'Next c
Next i

If blnkFnd Then
sMsg = "Blanks found on the following cells:"
sMsg = sMsg & vbLf & vbLf
sMsg = sMsg & Join(Split(Mid(cBlnk, 2), ","), vbLf)
Else
'Exit Sub
sMsg = "Blanks not found"
End If

MsgBox sMsg
End Sub

Loop not quite working correctly
 

I notice I have c Dimmed twice.

Dim c As Range, Rng As Range
Dim OneRng As Range, c As Range

That is a typo, otherwise code problem is as stated.

Howard

Loop not quite working correctly
 

I notice I have c Dimmed twice.

Dim c As Range, Rng As Range
Dim OneRng As Range, c As Range

That is a typo, otherwise code problem is as stated.

Howard

Putting Option Explicit* at the top of code modules will catch
duplicate declarations. You can have this done automatically by
checking the option in the VBE Tools Options dialog...

Require Variable Declaration

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

Loop not quite working correctly
 

Try filtering your range on blank cells only in a For Each loop...


Sub FilterOnBlankCells()
Dim OneRng As Range, c As Range, sBlanks$, vMsg
Set OneRng = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
For Each c In OneRng.SpecialCells(xlCellTypeBlanks)
sBlanks = sBlanks & "|" & c.Address
Next 'c

If sBlanks < "" Then
vMsg = "Blanks found on the following cells:" & vbLf & vbLf
vMsg = vMsg & Join(Split(Mid(sBlanks, 2), "|"), vbLf)
Else
vMsg = "No blanks found"
End If
MsgBox vMsg
End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

Loop not quite working correctly
 

New and improved version...

Sub FilterOnBlankCells()
Dim OneRng As Range, c As Range, sBlanks$, vMsg

Set OneRng = Range("N1:N" & Cells(Rows.Count, "N").End(xlUp).Row)
On Error GoTo ErrExit

For Each c In OneRng.SpecialCells(xlCellTypeBlanks)
sBlanks = sBlanks & "|" & c.Address
Next 'c

ErrExit:
If Err = 0 Then
vMsg = "Blanks found on the following cells:" & vbLf & vbLf
vMsg = vMsg & Join(Split(Mid(sBlanks, 2), "|"), vbLf)
Else
vMsg = "No blanks found"
End If
MsgBox vMsg, vbInformation
End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

Loop not quite working correctly
 

Thanks, Garry.

Both are good as gold.

Although the newer version was a surprise keying on column N. Changed it to my data and is golden.

I actually do use Option Explicit as the default, I was consolidating a generalized version of the few versions of code I had tried while trying to find the correct code, and copied back some bogus stuff.

Thanks for the help.

Howard

Loop not quite working correctly
 

Hi Howard,

Am Tue, 26 May 2015 22:51:16 -0700 (PDT) schrieb L. Howard:

Thanks, Garry.

here is Garry's last version slightly amended:

Sub FilterOnBlankCells()
Dim OneRng As Range, c As Range, sBlanks$, vMsg

Set OneRng = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
If Application.CountBlank(OneRng) = 0 Then
vMsg = "No blanks found"
Else
For Each c In OneRng.SpecialCells(xlCellTypeBlanks)
sBlanks = sBlanks & "|" & c.Address(0, 0)
Next 'c
vMsg = "Blanks found on the following cells:" & vbLf & vbLf
vMsg = vMsg & Join(Split(Mid(sBlanks, 2), "|"), vbLf)
End If
MsgBox vMsg, vbInformation
End Sub


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

Loop not quite working correctly
 

Thanks, Garry.

Both are good as gold.

Although the newer version was a surprise keying on column N.
Changed it to my data and is golden.

I actually do use Option Explicit as the default, I was consolidating
a generalized version of the few versions of code I had tried while
trying to find the correct code, and copied back some bogus stuff.

Thanks for the help.

Howard

Yeah, I only have data in col "N" on my test sheet. I assumed you'd
edit to suit!<g

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

Loop not quite working correctly
 

Hi Howard,

Am Tue, 26 May 2015 22:51:16 -0700 (PDT) schrieb L. Howard:

Thanks, Garry.

here is Garry's last version slightly amended:

Sub FilterOnBlankCells()
Dim OneRng As Range, c As Range, sBlanks$, vMsg

Set OneRng = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
If Application.CountBlank(OneRng) = 0 Then
vMsg = "No blanks found"
Else
For Each c In OneRng.SpecialCells(xlCellTypeBlanks)
sBlanks = sBlanks & "|" & c.Address(0, 0)
Next 'c
vMsg = "Blanks found on the following cells:" & vbLf & vbLf
vMsg = vMsg & Join(Split(Mid(sBlanks, 2), "|"), vbLf)
End If
MsgBox vMsg, vbInformation
End Sub


Regards
Claus B.

Very nice, Claus!
This would be much faster if the range was large and no blank cells.

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

Loop not quite working correctly
 

Hi again,

Am Wed, 27 May 2015 10:48:16 +0200 schrieb Claus Busch:

Sub FilterOnBlankCells()

or try it this way. Connected cells are written as ranges:

Sub Test()
Dim OneRng As Range, sBlanks$, vMsg

Set OneRng = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
If Application.CountBlank(OneRng) = 0 Then
vMsg = "No blanks found"
Else
sBlanks = OneRng.SpecialCells(xlCellTypeBlanks).Address(0, 0)
sBlanks = Join(Split(sBlanks, ","), Chr(10))
vMsg = "Blanks found on the following cells:" & vbLf & vbLf & sBlanks
End If
MsgBox vMsg, vbInformation
End Sub


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

Loop not quite working correctly
 

Hi again,

Am Wed, 27 May 2015 10:48:16 +0200 schrieb Claus Busch:

Sub FilterOnBlankCells()

or try it this way. Connected cells are written as ranges:

Sub Test()
Dim OneRng As Range, sBlanks$, vMsg

Set OneRng = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
If Application.CountBlank(OneRng) = 0 Then
vMsg = "No blanks found"
Else
sBlanks = OneRng.SpecialCells(xlCellTypeBlanks).Address(0, 0)
sBlanks = Join(Split(sBlanks, ","), Chr(10))
vMsg = "Blanks found on the following cells:" & vbLf & vbLf &
sBlanks End If
MsgBox vMsg, vbInformation
End Sub


Regards
Claus B.

Ah.., and I like it too!<g

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

Loop not quite working correctly
 

Hi Garry and Claus,

Here is the finished product, a before close alert for blank cells, and an alert box of those blank cells.

Thanks a ton for the excellent codes.

Howard


Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim myCnt As Long, Diff As Long
Dim OneRng As Range, sBlanks$, vMsg

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

Diff = Cells(Rows.Count, "A").End(xlUp).Row - myCnt
If Not Me.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
End If
End If

If Application.CountBlank(OneRng) = 0 Then
'Exit Sub
vMsg = "No blanks found"
Else

sBlanks = OneRng.SpecialCells(xlCellTypeBlanks).Address(0, 0)
sBlanks = Join(Split(sBlanks, ","), Chr(10))
vMsg = "Blanks cells a" & vbLf & vbLf & sBlanks

End If
MsgBox vMsg, vbInformation
End Sub

Loop not quite working correctly
 

Hi Garry,

Am Wed, 27 May 2015 05:03:18 -0400 schrieb GS:

This would be much faster if the range was large and no blank cells.

appreciate the praise of an expert.
If possible I rather check the occurance of that cell type than handle
an error when working with SpecialCells


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

Loop not quite working correctly
 

Hi Garry,

Am Wed, 27 May 2015 05:03:18 -0400 schrieb GS:

This would be much faster if the range was large and no blank cells.

appreciate the praise of an expert.

More like a colleague to me!

If possible I rather check the occurance of that cell type than
handle an error when working with SpecialCells


Makes sense! The error handling was needed to keep the msgbox code
together. Though your idea escapes the loop if there are no blanks.
Better approach IMO.

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

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

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

Loop not quite working correctly
 

Hi Claus,

What I was shooting for was to make the code adaptable to the length of column A.

But it really is not that difficult to adjust the ranges in the code to match column A, should it change.

Thanks for the tweaks, which include the last cell, should it be a blank.

Howard

Loop not quite working correctly
 

Hi Howard,

Am Wed, 27 May 2015 07:23:34 -0700 (PDT) schrieb L. Howard:

What I was shooting for was to make the code adaptable to the length of column A.

then insert a variable LastRow:

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

'Modify the last expected row in column A
Const LastRow = 200

Set OneRng = Range("A1:A" & LastRow)
myCnt = Application.CountA(OneRng)
If Len(Cells(LastRow + 1, 1)) = 0 Then Cells(LastRow + 1, 1) = "End"

Diff = 200 - myCnt
If Not ThisWorkbook.Saved Then
If Diff 0 Then
Cancel = True
MsgBox "Cells A1 to A" & LastRow & " " & _
" 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

Loop not quite working correctly
 

Hi again,

Am Wed, 27 May 2015 16:31:33 +0200 schrieb Claus Busch:

then insert a variable LastRow:
and you have to put the line with the MsgBox into the IF statement or
you always have a MsgBox. If all cells are filled the MsgBox has not
text:

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

'Modify the last expected row in column A
Const LastRow = 200

Set OneRng = Range("A1:A" & LastRow)
myCnt = Application.CountA(OneRng)
If Len(Cells(LastRow + 1, 1)) = 0 Then Cells(LastRow + 1, 1) = "End"

Diff = 200 - myCnt
If Not ThisWorkbook.Saved Then
If Diff 0 Then
Cancel = True
MsgBox "Cells A1 to A" & LastRow & " " & _
" 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
MsgBox vMsg, vbInformation
End If
End If
End Sub


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

Loop not quite working correctly
 

That seems to clean it up quite nice.

Again, thanks for great help.

Howard