Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#10
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#11
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#12
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#13
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#14
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#15
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#16
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#17
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#18
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#19
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#20
Posted to microsoft.public.excel.programming
|
|||
|
|||
Loop not quite working correctly
That seems to clean it up quite nice.
Again, thanks for great help. Howard |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Macro not working correctly | Excel Discussion (Misc queries) | |||
AutoSum not working correctly | Excel Discussion (Misc queries) | |||
WorksheetFunction not working correctly | Excel Discussion (Misc queries) | |||
loop does not work correctly | Excel Programming | |||
Cursor not working correctly | Excel Discussion (Misc queries) |