coserria
03-17-2008, 12:55 PM
: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
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