Running code on multiple sheets
Posted by Caffeinekid on February 04, 2002 8:34 AM
Hi all,
Ok so heres the deal. I have a program that opens 7 sheets and then runs a do loop to compile data on each. What I'm trying to do is speed up the program right now its really slow because I have 7 little do loops in one big loop. What I'd like to do is write a loop that selects all the sheets and then will loop through one small do loop for each of the sheets insted of having multiple do loops. I'm using an array to select the 7 sheets. I know this can be done but its monday and my brain wont work.
Thanks,
Caffeine_Kid
Posted by DK on February 04, 2002 9:26 AM
Post your code (NT)
P
Posted by Caffeine Kid on February 04, 2002 9:51 AM
Re: Post your code (NT)
What I'm not sure about is the for loop. Is there an easier way to get the do loop to run on each of the seven worksheets? I've never had to run the same code on multiple sheets before so I'm not really sure how it should look.
Private Sub CommandButton2_Click()
Dim i, j As Integer
Dim bob2 As String
Dim bob As Variant
Sheets(Array("Report", "Report (2)", "Report (3)")).Select
For Each sheet In Selection
With ActiveSheet
i = 1
j = 1
.Cells(j, 10).Select
Do
bob = ActiveCell.Value
bob2 = Left(bob, 3)
If bob2 = "SST" Or bob2 = "LC " Or bob2 = "Pac" Or bob2 = "Ind" Or bob2 = "HOL" Or bob2 = " " Or bob = Empty Then
j = j + 1
.Cells(j, 10).Select
Else
ActiveCell.EntireRow.Delete
End If
i = i + 1
Loop Until i = 6000
End With
Next sheet
End Sub
Posted by Rosencrantz on February 04, 2002 4:49 PM
Try this .....
I have assumed that you want the macro to run on all the worksheets :-
Private Sub CommandButton2_Click()
Dim Sh As Worksheet, rng As Range, cell As Range, toDelete As Range
Dim x As Integer, bob As String
Application.ScreenUpdating = False
For Each Sh In Worksheets
Sh.Activate
x = 0
Set rng = Range([I1], [I65536].End(xlUp))
For Each cell In rng
bob = Left(cell.Value, 3)
If bob = "SST" Or bob = "LC " Or bob = "Pac" Or bob = "Ind" Or bob = "HOL" Or bob = " " Or bob = Empty Then
GoTo e
Else
If x <> 0 Then
Set toDelete = Union(toDelete, cell)
Else
x = 1
Set toDelete = cell
End If
End If
e:
Next cell
If x <> 0 Then toDelete.EntireRow.Delete
Next Sh
End Sub
