LinkBack Thread Tools Search this Thread Display Modes
Prev Previous Post   Next Post Next
  #6   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 390
Default Delete range rows if all cells blank (Was: add new row)

[Whoops, well, I found some incorrigible bugs in the first version of
the below. I'm superseding the article with ver. 1.1 of my code. The
problems we (1) I forgot to use "Step -1" in the area loop for
multiple rows, so the looping got screwed up; and (2) it turns out
that ".Find("?") = FALSE" is satisfied with the number 0, but I
wanted only blank cells -- so I needed a workaround there. I
also removed some needless extra looping in this version. =dman=]

Regarding the desire to delete any row in a range which contains only
blank cells: the received wisdom has been to loop.

I tried to think of an efficient way. I didn't like looping
through all rows. I decided we could just look for areas that are
blank and delete them without looping. Then all that might be left
would be multi-row areas that turn out not to be empty in all cells
of the row's range. We could simply loop through those few and
decide. It took me some work, but I have code now that works. I
will put it up on a web page later this weekend. (The URL is in a
comment below, but so far there's nothing there.)

Improvements gladly solicited.

=dman=

'----------------------
Option Explicit
Sub DelEmptyRows()

' If all cells in a row within range are empty, delete row
' Ver. 1.1 by Dallman Ross, 8 Sep 2007; use freely
' Latest version: http://heliotropos.com/xl/code/samples.html
'
' Goal was to reduce looping to a minimum; _
hence, we only loop through multi-row "candidate" areas _
as needed

Dim iLastRow, iLastCol As Long
Dim startCell, myIsect, myRg As Range
Dim area As Range
Dim r As Long


Set startCell = Range("A1") ' change as desired

iLastRow = Cells(Rows.Count, startCell).End(xlUp).row
iLastCol = Cells(1, Columns.Count).End(xlToLeft).Column

On Error Resume Next
Set myRg = Range(startCell, Cells(iLastRow, iLastCol))

Set myIsect = Intersect(myRg, _
Columns(startCell).SpecialCells(xlCellTypeBlanks)) . _
EntireRow.Areas ' all range rows with blanks in 1st col.


For Each area In myIsect
area.Activate
'Debug.Print area.row

If Selection.Find("?").Activate = False Then
If Selection < 0 Then
'// There were only blank cells in the range row(s)
Selection.EntireRow.Delete
End If

ElseIf area.Rows.Count 1 Then
'// Loop through remaining multirow "candidate" ranges _
only as needed

'Debug.Print area.Rows.Count, area.row
For r = area.row + area.Rows.Count - 1 To area.row Step -1
Intersect(area, Rows(r)).Select

If Selection.Find("?").Activate = False Then
If Selection < 0 Then
Selection.EntireRow.Delete
End If
End If
Next 'r
End If
Next 'area

End Sub


'----------------------

====================================
In , Dallman Ross <dman@localhost.
spake thusly:


Fair advice, methinks, Joel. Here's a different approach.
I confess I had trouble following what the OP's actual desire
is.

Sub test2()
' delete entire rows if row range is blank

Dim iLastRow, iLastCol As Long
Dim iRow As Long

iLastRow = Cells(Rows.Count, "C").End(xlUp).row
iLastCol = Cells(1, Columns.Count).End(xlToLeft).Column

For iRow = iLastRow To 1 Step -1
With Range(Cells(iRow, "A"), Cells(iRow, iLastCol)).Activate
On Error Resume Next
If Not Selection.Find(What:="?").Activate Then
Rows(iRow).Delete
iLastRow = iLastRow - 1
End If
End With
Next 'iRow

' use iLastRow to create the Totals row now as desired
Debug.Print "iLastRow Is Now " & iLastRow

End Sub

=dman=

============================
In , Joel
spake thusly:

Inserting rows and deleting rows at the same time becomes a very
difficult task to get your loop counters correct. I recommend
that you do it in two passes. First Delete rows then add rows.

When you add rows you usually have to have two counters. One to
keep track of the number of times to loop through the code. The
second to count the row number.

When deleting you have to increment your loop counter only when
you are not deleting a row. Here is a simple version of the
delete

Sub test()

LastRow = Cells(Rows.Count, "A").End(xlUp).Row

RowCount = 1
For LoopCount = 1 To LastRow
LastColumn = Cells(RowCount, Columns.Count).Column
found = False
For ColumnCount = 1 To LastColumn
If Not IsEmpty(Cells(RowCount, ColumnCount)) Then
found = True
Exit For
End If
Next ColumnCount
If found = False Then
Rows(RowCount).Delete
Else
RowCount = RowCount + 1
End If

Next LoopCount

End Sub
"Patrick Bateman" wrote:

i have a sheet populated by data from a database query, parts
of the rows of data are coppied into a different sheet with a
totals row at the bottom. The problem is, the data i am using
can range from 10 to hundreds of rows long, but the totals row
always needs to be at the bottom of the data (next to it).

what i really want to do is create a macro that inserts a row
underneith a row which contains values (specifically values as
all rows contain formulas) and deletes rows if the row above is
empty.

i have a macro that adds a new row and fills down the
formulas only from the line above, but getting it to run to
thte above specifications is causing a problem.

Any ideas or help would be much appreiated

regards

Patrick

 
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On



All times are GMT +1. The time now is 09:15 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"