Cell Selection and movement

stooven

New Member
Joined
Oct 12, 2006
Messages
15
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
 

Excel Facts

How to total the visible cells?
From the first blank cell below a filtered data set, press Alt+=. Instead of SUM, you will get SUBTOTAL(9,)

Norie

Well-known Member
Joined
Apr 28, 2004
Messages
76,300
Office Version
  1. 365
Platform
  1. Windows
Steve

Do you have a specific question/problem?

Perhaps something like this might work?
Code:
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

New Member
Joined
Oct 12, 2006
Messages
15
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

Well-known Member
Joined
Apr 28, 2004
Messages
76,300
Office Version
  1. 365
Platform
  1. Windows
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

New Member
Joined
Oct 12, 2006
Messages
15

ADVERTISEMENT

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

Well-known Member
Joined
Apr 28, 2004
Messages
76,300
Office Version
  1. 365
Platform
  1. Windows
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. (y)
 

stooven

New Member
Joined
Oct 12, 2006
Messages
15
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
 

Forum statistics

Threads
1,137,206
Messages
5,680,191
Members
419,887
Latest member
Vasokir

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top