Thanks for your response.....
I'm not sure what I'm doing wrong but this is not working. I'm not
including Option Explicit or the Sub lines as the code you have
suggested is in the middle of other code, does the Option Explicit
have an impact that would not allow this to work?
Here is the code, which all works, except the area that you are
helping me with.....
Sub ryan_rae_weekly()
'Open file and execute macro against it
Application.Dialogs(xlDialogFindFile).Show
'Unhide Sheets hidden sheets
Dim Sheet As Worksheet
For Each Sheet In Worksheets
If Sheet.Visible = False Then
Sheet.Visible = True
End If
Next Sheet
'Deletes the sheets that we don't use.
Application.DisplayAlerts = False
Sheets("UST Service Provider").Delete
Sheets("US Trust Portfolio Info").Delete
Sheets("US Trust BAU Portfolio Info").Delete
Sheets("US Trust Project Info").Delete
Sheets("Service Provider").Delete
Sheets("Card Trans Portfolio Info").Delete
Sheets("Card Trans Project Info").Delete
Sheets("BAU Portfolio Info").Delete
Sheets("BAU Project Info").Delete
Sheets("Missing Timesheets").Delete
Sheets("US Trust BAU Funded").Delete
Application.DisplayAlerts = True
'Reorder Sheets
Sheets("BAU Data").Select
Sheets("BAU Data").Move Before:=Sheets(1)
Sheets("Trans Data").Select
Sheets("Trans Data").Move Before:=Sheets(2)
'Select BAU Data Sheet
Sheets("BAU Data").Select
'Set View at 100%
ActiveWindow.Zoom = 100
'Finds all rows with 'FS' and delete all other rows
Dim Firstrow As Long
Dim Lastrow As Long
Dim Lrow As Long
Dim CalcMode As Long
Dim ViewMode As Long
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
'We use the ActiveSheet but you can replace this with
'Sheets("MySheet")if you want
With ActiveSheet
'We select the sheet so we can change the window view
.Select
'If you are in Page Break Preview Or Page Layout view go
'back to normal view, we do this for speed
ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView
'Turn off Page Breaks, we do this for speed
.DisplayPageBreaks = False
'Set the first and last row to loop through
Firstrow = .UsedRange.Cells(1).Row + 1
Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row
'We loop from Lastrow to Firstrow (bottom to top)
For Lrow = Lastrow To Firstrow Step -1
'We check the values in the G column in this example
With .Cells(Lrow, "G")
If Not IsError(.Value) Then
If .Value <> "FS" Then .EntireRow.Delete
'This will delete each row that doesn't have a Value "FS"
in Column G, case sensitive.
End If
End With
Next Lrow
End With
ActiveWindow.View = ViewMode
With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With
'Clean-up Worksheet
Dim myLastRow As Long
Dim myLastCol As Long
Dim wks As Worksheet
Dim dummyRng As Range
For Each wks In ActiveWorkbook.Worksheets
With wks
myLastRow = 0
myLastCol = 0
Set dummyRng = .UsedRange
On Error Resume Next
myLastRow = _
.Cells.Find("*", after:=.Cells(1), _
LookIn:=xlFormulas, lookat:=xlWhole, _
searchdirection:=xlPrevious, _
searchorder:=xlByRows).Row
myLastCol = _
.Cells.Find("*", after:=.Cells(1), _
LookIn:=xlFormulas, lookat:=xlWhole, _
searchdirection:=xlPrevious, _
searchorder:=xlByColumns).Column
On Error GoTo 0
If myLastRow * myLastCol = 0 Then
.Columns.Delete
Else
.Range(.Cells(myLastRow + 1, 1), _
.Cells(.Rows.Count, 1)).EntireRow.Delete
.Range(.Cells(1, myLastCol + 1), _
.Cells(1, .Columns.Count)).EntireColumn.Delete
End If
End With
Next wks
' Sort by ECMSID Number
Range("A1:S9639").Sort Key1:=Range("B2"), Order1:=xlAscending,
Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom, _
DataOption1:=xlSortTextAsNumbers
' Hide Columns
Range("A2").Select
Columns("E:G").Select
Selection.EntireColumn.Hidden = True
Columns("H:L").Select
Selection.EntireColumn.Hidden = True
Columns("P:U").Select
Selection.EntireColumn.Hidden = True
Columns("N:N").Select
Selection.EntireColumn.Hidden = True
' Format column O with 2 decimal
Columns("O:O").Select
Selection.NumberFormat = "0.00"
' Resize columns
' Column Widths
Columns("A:B").Select
Selection.ColumnWidth = 10.5
Columns("C").Select
Selection.ColumnWidth = 18.5
Columns("D").Select
Selection.ColumnWidth = 40.88
Columns("M").Select
Selection.ColumnWidth = 8.75
Columns("O").Select
Selection.ColumnWidth = 8.75
'Reposition
Range("A2").Select
'Next Worksheet
'Select BAU Data Sheet
Sheets("Trans Data").Select
Range("A2").Select
'Set View at 100%
ActiveWindow.Zoom = 100
'Finds all rows with 'FS' and delete all other rows
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
'We use the ActiveSheet but you can replace this with
'Sheets("MySheet")if you want
With ActiveSheet
'We select the sheet so we can change the window view
.Select
'If you are in Page Break Preview Or Page Layout view go
'back to normal view, we do this for speed
ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView
'Turn off Page Breaks, we do this for speed
.DisplayPageBreaks = False
'Set the first and last row to loop through
Firstrow = .UsedRange.Cells(1).Row + 1
Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row
'We loop from Lastrow to Firstrow (bottom to top)
For Lrow = Lastrow To Firstrow Step -1
'We check the values in the G column in this example
With .Cells(Lrow, "G")
If Not IsError(.Value) Then
If .Value <> "FS" Then .EntireRow.Delete
'This will delete each row that doesn't have a Value "FS"
in Column G, case sensitive.
End If
End With
Next Lrow
End With
ActiveWindow.View = ViewMode
With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With
'Clean-up Worksheet
For Each wks In ActiveWorkbook.Worksheets
With wks
myLastRow = 0
myLastCol = 0
Set dummyRng = .UsedRange
On Error Resume Next
myLastRow = _
.Cells.Find("*", after:=.Cells(1), _
LookIn:=xlFormulas, lookat:=xlWhole, _
searchdirection:=xlPrevious, _
searchorder:=xlByRows).Row
myLastCol = _
.Cells.Find("*", after:=.Cells(1), _
LookIn:=xlFormulas, lookat:=xlWhole, _
searchdirection:=xlPrevious, _
searchorder:=xlByColumns).Column
On Error GoTo 0
If myLastRow * myLastCol = 0 Then
.Columns.Delete
Else
.Range(.Cells(myLastRow + 1, 1), _
.Cells(.Rows.Count, 1)).EntireRow.Delete
.Range(.Cells(1, myLastCol + 1), _
.Cells(1, .Columns.Count)).EntireColumn.Delete
End If
End With
Next wks
' Hide Columns
Range("A2").Select
Columns("E:G").Select
Selection.EntireColumn.Hidden = True
Columns("N:N").Select
Selection.EntireColumn.Hidden = True
Columns("P:S").Select
Selection.EntireColumn.Hidden = True
' CODE FOR REMOVING BLANK COLUMNS
HERE!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Dim myCol As Range
Set wks = Worksheets("Trans Data")
With wks
For Each myCol In .UsedRange.Columns
If Application.CountA(.Range(.Cells(2, myCol.Column), _
.Cells(.Rows.Count, myCol.Column))) = ""
Then
'hide it
myCol.Hidden = True
Else
'unhide any previously hidden column???
myCol.Hidden = False
End If
Next myCol
End With
' Resize columns widths
Columns("A:B").Select
Selection.ColumnWidth = 10.5
Columns("C").Select
Selection.ColumnWidth = 18.5
Columns("D").Select
Selection.ColumnWidth = 40.88
Selection.ColumnWidth = 34.57
Columns("H:M").Select
Selection.ColumnWidth = 8.75
Columns("H:M").Select
Selection.ColumnWidth = 8.75
' Format column O with 2 decimal
Columns("H:O").Select
Selection.NumberFormat = "0.00"
'Sort and subtotal by CR Number
Range("A2").Select
Selection.Subtotal GroupBy:=2, Function:=xlSum,
TotalList:=Array(8, 9, 10, _
11, 12, 13, 15), Replace:=True, PageBreaks:=False,
SummaryBelowData:=True
'Reposition
Range("A2").Select
'Next Worksheet
'Select BAU Data Sheet
Sheets("US Trust Data").Select
Range("A2").Select
'Set View at 100%
ActiveWindow.Zoom = 100
'Finds all rows with 'FS' and delete all other rows
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
'We use the ActiveSheet but you can replace this with
'Sheets("MySheet")if you want
With ActiveSheet
'We select the sheet so we can change the window view
.Select
'If you are in Page Break Preview Or Page Layout view go
'back to normal view, we do this for speed
ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView
'Turn off Page Breaks, we do this for speed
.DisplayPageBreaks = False
'Set the first and last row to loop through
Firstrow = .UsedRange.Cells(1).Row + 1
Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row
'We loop from Lastrow to Firstrow (bottom to top)
For Lrow = Lastrow To Firstrow Step -1
'We check the values in the F column in this example
With .Cells(Lrow, "F")
If Not IsError(.Value) Then
If .Value <> "FS" Then .EntireRow.Delete
'This will delete each row that doesn't have a Value "FS"
in Column G, case sensitive.
End If
End With
Next Lrow
End With
ActiveWindow.View = ViewMode
With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With
'Clean-up Worksheet
For Each wks In ActiveWorkbook.Worksheets
With wks
myLastRow = 0
myLastCol = 0
Set dummyRng = .UsedRange
On Error Resume Next
myLastRow = _
.Cells.Find("*", after:=.Cells(1), _
LookIn:=xlFormulas, lookat:=xlWhole, _
searchdirection:=xlPrevious, _
searchorder:=xlByRows).Row
myLastCol = _
.Cells.Find("*", after:=.Cells(1), _
LookIn:=xlFormulas, lookat:=xlWhole, _
searchdirection:=xlPrevious, _
searchorder:=xlByColumns).Column
On Error GoTo 0
If myLastRow * myLastCol = 0 Then
.Columns.Delete
Else
.Range(.Cells(myLastRow + 1, 1), _
.Cells(.Rows.Count, 1)).EntireRow.Delete
.Range(.Cells(1, myLastCol + 1), _
.Cells(1, .Columns.Count)).EntireColumn.Delete
End If
End With
Next wks
' Hide Columns
Range("A2").Select
Columns("D
").Select
Selection.EntireColumn.Hidden = True
Columns("F:K").Select
Selection.EntireColumn.Hidden = True
Columns("O:O").Select
Selection.EntireColumn.Hidden = True
' Format column O with 2 decimal
Columns("L:O").Select
Selection.NumberFormat = "0.00"
' Resize columns widths
Columns("A:A").Select
Selection.ColumnWidth = 9
Columns("B:B").Select
Selection.ColumnWidth = 10.83
Columns("C:C").Select
Selection.ColumnWidth = 26.25
Columns("E:E").Select
Selection.ColumnWidth = 11.63
Columns("L:L").Select
Selection.ColumnWidth = 11.63
Columns("M:M").Select
Selection.ColumnWidth = 15.63
Columns("N:N").Select
Selection.ColumnWidth = 9.88
'Positioning
Range("A2").Select
'Back to first sheet and positioning
Sheets("BAU Data").Select
Range("A2").Select
'Save file As
Application.Dialogs(xlDialogSaveAs).Show
End Sub
