Cell Selection and movement

[stooven]

Greetings and felicitudes,
I am new to both my job and VB and I'm trying to automate a few tasks around the office. I run excel 97. I've put together a script from parts of posts from your archive and the macro recorder.

Here is what my script is intended to do:
I have a type of spreadsheet with 11 columns and a variable number of rows. I want every row containing a cell with the value 0 (this doesn't include blanks) in either column D or Column I (or both) moved to a second blank worksheet and the cells shifted up.

This is what I came up with up on my own. (It isn't complete)

Sub Zeroremover()
Dim cell As Range
Dim aRange As Range
Set aRange = Range(Range("I1"), Range("I65536").End(xlUp))
For Each cell In aRange
If cell.Value <> "0" Then
cell.EntireRow.Hidden = True
End If
Next cell
aRange.SpecialCells(xlCellTypeVisible).EntireRow.Copy
Selection.Copy
Sheets("Sheet2").Select
ActiveSheet.Paste
Sheets("Sheet1").Select
End Sub

Any help would be greatly appreciated!

Steve

 

[Norie]

Steve

Do you have a specific question/problem?

Perhaps something like this might work?

Sub Zeroremover()
Dim cell As Range
Dim aRange As Range
Set aRange = Range(Range("I1"), Range("I65536").End(xlUp))

    For Each cell In aRange
        If cell.Value <> "0" Then
            cell.EntireRow.Hidden = True
        End If
    Next cell
    
    aRange.SpecialCells(xlCellTypeVisible).EntireRow.Copy Sheets("Sheet2").Range("A1")

End Sub

 

[stooven]

Yes, actually, that works very nicely. Thank you very much. However, I have two concerns:

The rows with 0 D or I are still there. (once they're moved, Id like them to be gone from sheet 1)

It turns out that these spreadsheets are usually very, very large (approx. 25k rows) and the number of rows moved is usually only about 50. I bet I could cut processing time by a lot if instead of:

If cell.Value <> "0" Then

I used a

If cell.Value = "0" Then

don't you think?

 

[Norie]

Steve

You could probably cut processing time by eliminating the loop.

But it's not immediately clear what you want to do, and your second post mentions "0 D or I", rather than just 0.

 

[stooven]

Hey, Norie
I'm sorry. I'm not very good with this at all. To clairify "0 D or I," I mean that each of my sheets has 11 columns. The only two that the script is concerned with are D and I.

If, for a given row x, the value of either Dx or Ix were to equal 0, I would want the whole row removed from sheet 1 and sent to sheet 2 and the cells shifted up.

I think I understand what you mean by removing the loop... something like this? (but this doesn't work)

Sub Zeroremover()
Dim cell As Range
Dim aRange As Range
Set aRange = Range(Range("I1"), Range("I65536").End(xlUp))

For Each cell In aRange
If cell.Value = "0" Then
cell.EntireRow.Cut
Sheets("Sheet2").Select
ActiveSheet.Paste
Sheets("Sheet1").Select
End If
Next cell

aRange.SpecialCells(xlCellTypeVisible).EntireRow.Copy Sheets("Sheet2").Range("A1")

End Sub

Thanks for being patient with me.

Steve

 

[Norie]

Steve

That's still looping.

What I was thinking of was using Advanced/Auto filter.

If you can give some more information we'll be glad to help, but I'm just off now.

 

[stooven]

Ok, Im almost out for the night too. Ill mess with this a little and figure out how to post screenshots and use code tags properly because Im sure that drives you guys nuts =-p

Steve