Selecting Rows in Excel Using Relative References

I am trying to create a macro in Excel 97 that does the following:

1. Finds the first blank row
2. Select this row and the 2 rows below it.
3. Delete these three rows.
4. Continue this routine until there is four blank rows which would mean the end of the information block.
LVL 4
nmilmineAsked:
Who is Participating?
 
calacucciaConnect With a Mentor Commented:
Hi Neil,

Here's your updated version, now looking in column B and deleting all rows containing no data in column B.

Sub DeleteRowsRoutine()
Dim c As Range, R As Range
Dim ws As Worksheet
Dim LastRow As Integer
Dim i As Integer
Set ws = ActiveSheet
LastRow = ws.Cells(1, 1).SpecialCells(xlCellTypeLastCell).Row
While i < LastRow
i = i + 1
'Following line is remmed at the moment, delete first ' if you want to see the progression
'ws.Cells(i,2).Select
If ws.Cells(i, 2) = "" Then
NextEmptyLine = ws.Cells(i, 2).End(xlDown).Row - 1
ws.Rows(i & ":" & NextEmptyLine).Delete
i = i - 1
LastRow = LastRow - NextEmptyLine + i
End If
Wend
End Sub

Good Luck
Calacuccia
0
 
rsteuryCommented:
nmilmine,

This may help -- I would submit an answer but I don't think I know enough about the record and data fields -- also do not have any error checking --


This may help you though---

  Range("A1").Select
  Do
   Do Until (ActiveCell = "")
       ActiveCell.Offset(1, 0).Select
   Loop
   If Not (ActiveCell.Offset(1, 0) = "") Then
    ActiveCell.Offset(0, 0).Range("A1:A3").Select
    Selection.EntireRow.Delete
   Else
     Exit Do
   End If
  Loop

0
 
calacucciaCommented:
Well, here's another way to do it...

Sub DeleteRowsRoutine()
Dim c As Range, R As Range
Dim LastRow As Integer
For Each R In ActiveSheet.UsedRange.rows
For Each c In R.rows("1:4").Cells
If c <> "" Then GoTo NextRow
Next c
LastRow = R.Row - 1
GoTo DeletionLoop
NextRow:
Next R
DeletionLoop:
If LastRow = 0 Then LastRow = ActiveSheet.UsedRange.rows.Count
For i = LastRow To 1 Step -1
For Each c In rows(i).Cells
If c <> "" Then GoTo GoOn
Next c
rows(i & ":" & i + 2).Delete
GoOn:
Next i
End Sub

It checks complete rows for emptyness, but first determines where the last row of the information block is, assigns the last row number before 4 empty rows to the variable LastRow andd then performs the deletion upwards.

Deleting upwards is better than deleting downwards, because when going down, the first row after three deleted ones would not be treated anymore.

Anyway, try it and report back

Have Fun
Calacuccia
0
Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
nmilmineAuthor Commented:
Hi Calacuccia

I copied your code to a module but, while it runs, nothing actually happens to the data.

The screen flashes as though something is happening but no changes occur

Regards
Neil
0
 
calacucciaCommented:
Hi Neil

Does the data contain complete empty rows of data or do you have empty cells with filled cels on same row but further to the right ?

In that case the macro won't do anything, it only checks complete empty rows.

Second possibility, do you have 4 empty rows at the top of your sheet. In that case the macro will do nothing neither, as it considers the 4 rows without data as the end of the to be processed block.

I retested the macro and it works perfect for me....

Waiting for more feedback

Calacuccia
0
 
nmilmineAuthor Commented:
Hi Calacuccia

This is a typical block copied from column A of the spreadsheet.  There is also information in columns B-I.  There is no information in the blank rows.  There are no blank rows at the start of the spreadsheet.

HPC8187
HPC9788
HPC9793

HEWLETT-PACKARD - HP Vectra Series - HP Vectra VLI8 Series

HPC8697
HPC8696
HPC9456

I am happy to email you the spreadsheet if you wish.

The running of the macro does not move the position of the starting cell, no matter which cell I start it from in column A.

Thanks for your help so far
Neil
0
 
nmilmineAuthor Commented:
Copy of all cells for same block

HPC8187      D8187N      HP Vectra VEi8 PIII 550 64Mb 8.4Gb HDD Soundcard  10/100 NIC Desktop NT4      2726.12      3587      Computer Systems      HEWLETT-PACKARD            10 days
HPC9788      D9788A      HP Vectra VEi8 PIII 600E 64Mb 13.5Gb HDD 48X CD  Soundcard Desktop Win95      2599.2      3420      Computer Systems      HEWLETT-PACKARD            10 days
HPC9793      D9793A      HP Vectra VEi8 PIII 650 64Mb 13.5Gb HDD 48X CD  Soundcard Desktop Win95      3644.2      4795      Computer Systems      HEWLETT-PACKARD            10 days

HEWLETT-PACKARD - HP Vectra Series - HP Vectra VLI8 Series                                                

HPC8697      D8697A      HP Vectra VLi8 Celeron 466a 64Mb 8.4Gb HDD 24X CD  Soundcard 10/100 NIC Small Form Factor Win95      1875.68      2468      Computer Systems      HEWLETT-PACKARD            10 days
HPC8696      D8696A      HP Vectra VLi8 Celeron 466a 32Mb 4.3Gb HDD  Soundcard 10/100 NIC Small Form Factor Win95      1824      2400      Computer Systems      HEWLETT-PACKARD            10 days
HPC9456      D9456A      HP Vectra VLi8 Celeron 500a 64Mb 8.4Gb HDD 24X CD  Soundcard 10/100 NIC Small Form Factor Win95      1928.12      2537      Computer Systems      HEWLETT-PACKARD            10 days
0
 
calacucciaCommented:
Hi Neill,

You can send me a copy to geert.dumortier7@yucom.be

I've tried an example similar to yours and just found an error. As I'm going up in he spreadsheet instead of going down, with your example, the three lines to be deleted are misinterpreted as first the bottom empty line and following two are deleted, then the top empty line and three following. But that does not match your observations neither, as you tell me nothing happened.

Before sending me the file, try this code:

Sub DeleteRowsRoutine()
Dim c As Range, R As Range
Dim LastRow As Integer
Dim i As Integer
For Each R In ActiveSheet.UsedRange.Rows
For Each c In R.Rows("1:4").Cells
If c <> "" Then GoTo NextRow
Next c
LastRow = R.Row - 1
GoTo DeletionLoop
NextRow:
Next R
DeletionLoop:
If LastRow = 0 Then LastRow = ActiveSheet.UsedRange.Rows.Count
While i < LastRow
i = i + 1
For Each c In Rows(i).Cells
If c <> "" Then GoTo GoOn
Next c
Rows(i & ":" & i + 2).Delete
i = i - 1
LastRow = LastRow - 3
GoOn:
Wend

The macro is not written to move to the cells, it just deletes rows without moving the active cell.

If you like to see the progress, change the macro to:

Sub DeleteRowsRoutine()
Dim c As Range, R As Range
Dim LastRow As Integer
Dim i As Integer
For Each R In ActiveSheet.UsedRange.Rows
For Each c In R.Rows("1:4").Cells
If c <> "" Then GoTo NextRow
Next c
LastRow = R.Row - 1
GoTo DeletionLoop
NextRow:
Next R
DeletionLoop:
If LastRow = 0 Then LastRow = ActiveSheet.UsedRange.Rows.Count
While i < LastRow
i = i + 1
Rows(i).Select
For Each c In Rows(i).Cells
If c <> "" Then GoTo GoOn
Next c
Rows(i & ":" & i + 2).Delete
i = i - 1
LastRow = LastRow - 3
GoOn:
Wend

Cheers & Good Luck
Calacuccia
0
 
nmilmineAuthor Commented:
Adjusted points from 50 to 100
0
 
nmilmineAuthor Commented:
Hi Calacuccia

The last sets of code made more sense.  I think that something was happening but I just couldn't see it so didn't believe it.

I have increased the points because I have just discovered that sometimes there are 5 lines that need removing.(don't you hate this kind of customer)

The only way to determine if a line should be removed is if there is nothing in the B column.

It would search down the B column and if there is nothing in the cell, make a selection down as many rows as there are cells in the B column that have nothing in them, delete these rows and then carry on ........
stopping when there are say more than 10 cells in the range it finds (meaning that you are at the end of the data

Thanks for your help to date
Neil
0
 
nmilmineAuthor Commented:
Thanks Calacuccia, its works great
0
 
calacucciaCommented:
You're Wellcome, Neil.

Calacuccia
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.