Solved: need to select and run macro on all worksheets in workbook consecutively

[coserria]

:help OK, here is it, I'm cleaning a series of data from a enterprise database. It spits out a report that is printable but contains footers and excess data that I don't need, I recorded a basic Macro and set some fields for deletion. I’m new to this and have not had any one look at this. It runs in a decent amount of time and is long. The problem is that the server that this report comes from is over loaded and I’m limited and have had to take the report in chunks and not a single report. Now I get it in 1 to 20 seperate worksheets and would liek to run this macro on all sheets with out having to restart it for each. I know it can be doen I just can't find it and I know it is very basic. I could not even record close to what I need.

How do I select all worksheets

For each ws in activeworkbook.worksheets
ws.activate

a friend gave me that but it gives errors.


PS I do not have my basics book with me it is in a different country now.

How do I get it to select each active worksheet in a workbook, I’m sure this can be done with out a loop.

Coserria

OK, here is it, I'm cleaning a series of data from a enterprise database. It spits out a report that is printable but contains footers and excess data that I don't need, I recorded a basic Macro and set some fields for deletion. I’m new to this and have not had any one look at this. It runs in a decent amount of time and is long. The problem is that the server that this report comes from is over loaded and I’m limited and have had to take the report in chunks and not a single report.

PS I do not have my basics book with me it is in a different country now.

How do I get it to select each active worksheet in a workbook, I’m sure this can be done with out a loop.

Coserria



Application.ScreenUpdating = False

Cells.MergeCells = False
Cells.WrapText = False

Range("A:B,D:E,S:S").Delete Shift:=xlToLeft





Cells.Replace What:="Unit Cost", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Cells.Replace What:="Line Cost", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Cells.Replace What:="Date", Replacement:="", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

Cells.Replace What:="Item:", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Cells.Replace What:="Location:", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Cells.Replace What:="Description:", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Cells.Replace What:="Item #:", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Cells.Replace What:="ME-IRQ-A*", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Cells.Replace What:="ME-IRQ-B*", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Cells.Replace What:="ME-IRQ-C*", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Cells.Replace What:="ME-IRQ-D*", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Cells.Replace What:="ME-IRQ-F*", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Cells.Replace What:="ME-IRQ-G*", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Cells.Replace What:="ME-IRQ-H*", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Cells.Replace What:="ME-IRQ-T*", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Cells.Replace What:="ME-IRQ-USMI", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Cells.Replace What:="Site: LOGCAP3", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Application.ScreenUpdating = True

'rows and colums here down


Dim Rw As Long, RwCnt As Long, rng As Range

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

On Error GoTo Exits:


If Selection.Columns.Count > 1 Then
Set rng = Selection
Else
Set rng = Range(Columns(1), Columns(ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Column()))
End If
ColCnt = 0
For col = rng.Columns.Count To 1 Step -1
If Application.WorksheetFunction.CountA(rng.Columns(col).EntireColumn) = 0 Then
rng.Columns(col).EntireColumn.Delete
ColCnt = ColCnt + 1
End If
Next col

'Range("B:B").Delete Shift:=xlToLeft

If Selection.Rows.Count > 1 Then
Set rng = Selection
Else
Set rng = Range(Rows(1), Rows(ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row()))
End If
RwCnt = 0
For Rw = rng.Rows.Count To 1 Step -1
If Application.WorksheetFunction.CountA(rng.Rows(Rw).EntireRow) = 0 Then
rng.Rows(Rw).EntireRow.Delete
RwCnt = RwCnt + 1
End If
Next Rw

'insert cell for alignment

Range("B1,D1").Insert Shift:=xlDown

If Selection.Rows.Count > 1 Then
Set rng = Selection
Else
Set rng = Range(Rows(1), Rows(ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row()))
End If
RwCnt = 0
For Rw = rng.Rows.Count To 1 Step -1
If Application.WorksheetFunction.CountA(rng.Rows(Rw).EntireRow) = 0 Then
rng.Rows(Rw).EntireRow.Delete
RwCnt = RwCnt + 1
End If
Next Rw

Exits:

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

Cells.Interior.ColorIndex = xlNone
Cells.EntireColumn.AutoFit

End Sub

[Bob Phillips]

That code looks correct.What do you get?

[coserria]

it comes back as a compile error: for without next


this is taking place at END SUB

i also had an error and had to chage the code below

For each ws in activeworkbook.worksheets
ws.activate

TO:

'For each ws in

activeworkbook.worksheets
ws.activate

The basic code works great I spent a bit of time running though it a few months back. I just got back from vacation and the database people screwed me. Oh well I can adjust. just cant see the forest in the trees.

[Bob Phillips]

You need a



Next ws


at the end of the loop, after you have procesed the worksheet

[mdmackillop]

Try the following

Option Explicit
Sub Test()
Dim ws As Worksheet
Dim arr, a
Dim Rw As Long, Col As Long, rng As Range
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
arr = Array("Unit Cost", "Line Cost", "Date") 'add other terms to be deleted

On Error GoTo Exits:
For Each ws In Worksheets
With ws
.Activate
.Cells.MergeCells = False
.Cells.WrapText = False
.Range("A:B,D:E,S:S").Delete Shift:=xlToLeft
'Find and delete terms
For Each a In arr
.Cells.Replace What:=a, Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Next a
'rows and colums here down
Set rng = Range(ws.Columns(1), Columns(ws.Cells.SpecialCells(xlCellTypeLastCell).Column()))
For Col = rng.Columns.Count To 1 Step -1
If Application.WorksheetFunction.CountA(rng.Columns(Col).EntireColumn) = 0 Then
rng.Columns(Col).EntireColumn.Delete
End If
Next Col
Set rng = Range(ws.Rows(1), Rows(ws.Cells.SpecialCells(xlCellTypeLastCell).Row()))
For Rw = rng.Rows.Count To 1 Step -1
If Application.WorksheetFunction.CountA(rng.Rows(Rw).EntireRow) = 0 Then
rng.Rows(Rw).EntireRow.Delete
End If
Next Rw
'insert cell for alignment
.Range("B1,D1").Insert Shift:=xlDown
Set rng = Range(ws.Rows(1), Rows(ws.Cells.SpecialCells(xlCellTypeLastCell).Row()))
For Rw = rng.Rows.Count To 1 Step -1
If Application.WorksheetFunction.CountA(rng.Rows(Rw).EntireRow) = 0 Then
rng.Rows(Rw).EntireRow.Delete
End If
Next Rw
.Cells.Interior.ColorIndex = xlNone
.Cells.EntireColumn.AutoFit
End With
Next ws
Exits:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

[coserria]

Thanks for the help, :friends:

I leaned a bit form that.

For the ones that are intersted in before it is cleaned report that is received is variable from 200 rows to well over a 1000.

the received code deffinatly helps I jsut have to go and reset the non variables.

Cheers thank for the assistance.