Home |
Search |
Today's Posts |
#6
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
[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 |