Hi All
Below I have put this VBA code to aid me in sorting out a number of verious reports.
The issue is that the ranges of data in the four reports are all diffrent, but the format of the report does not change and there are 4 tabs with the same data but for diffrent divisions.
So to make sure that the largest range is covered I had to imput the max range into the VBA code.
As for the print ing of each worksheet need it to print the data that is left behind once VBA has completed its steps
I am sure that I can change this to VBA code to only select the used ranges in each tab and file.
Please could you help me
MIG285
' ROL ALERET REPORT
'
' Keyboard Shortcut: Ctrl+k
'
Dim xrow As Long
Dim ws As Worksheet
Dim Lastrow As Long
Dim Firstrow As Long
Dim Lrow As Long
Dim DeleteValue As String
DeleteValue = "<1"
Sheets("SITE 0").RANGE("H2:U2").Select
Selection.AutoFill Destination:=RANGE("H2:U2200")
Columns("H:R").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Paste
Application.CutCopyMode = False
RANGE("$A$1:$U$2200").Select
Selection.AutoFilter
ActiveSheet.RANGE("$A$1:$U$2200").AutoFilter Field:=17, Operator:= _
xlFilterValues, Criteria2:=Array(0, "1/1/1970")
RANGE("P2:R2200").Select
Selection.ClearContents
ActiveSheet.RANGE("$A$1:$U$2200").AutoFilter Field:=17
ActiveSheet.RANGE("$A$1:$U$2200").AutoFilter Field:=15, Criteria1:= _
"#DIV/0!"
RANGE("O2:O2200").Select
Selection.Replace what:="#DIV/0!", Replacement:="=", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
ActiveSheet.RANGE("$A$1:$U$2200").AutoFilter Field:=15
ActiveSheet.RANGE("$A$1:$U$2200").AutoFilter Field:=13, Criteria1:=DeleteValue
With ActiveSheet.AutoFilter.RANGE
On Error Resume Next
Set rng = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not rng Is Nothing Then rng.EntireRow.Delete
End With
ActiveSheet.RANGE("$A$1:$U$2200").AutoFilter Field:=13
ActiveSheet.RANGE("$A$1:$U$2200").AutoFilter Field:=20, Criteria1:=Array("Not Needed"), Operator:=xlFilterValues
RANGE("A2").Select
RANGE(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.EntireRow.Delete
ActiveSheet.RANGE("$A$1:$U$2200").AutoFilter Field:=20
Selection.AutoFilter
ActiveWorkbook.Worksheets("SITE 0").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("SITE 0").Sort.SortFields.Add(RANGE("U2:U2200") _
, xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, _
0, 0)
ActiveWorkbook.Worksheets("SITE 0").Sort.SortFields.Add(RANGE("T2:T2200") _
, xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, _
0, 0)
ActiveWorkbook.Worksheets("SITE 0").Sort.SortFields.Add(RANGE("S2:S2200") _
, xlSortOnFontColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, _
0, 0)
ActiveWorkbook.Worksheets("SITE 0").Sort.SortFields.Add(RANGE("S2:S2200") _
, xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, _
255, 0)
ActiveWorkbook.Worksheets("SITE 0").Sort.SortFields.Add(RANGE("S2:S2200") _
, xlSortOnFontColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(0, _
112, 192)
ActiveWorkbook.Worksheets("SITE 0").Sort.SortFields.Add(RANGE("S2:S2200") _
, xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(0, _
176, 80)
With ActiveWorkbook.Worksheets("SITE 0").Sort
.SetRange RANGE("A1:U2200")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
On Error Resume Next
RANGE("A:A").SpecialCells(xlBlanks, _
xlTextValues).EntireRow.Delete
On Error GoTo 0
ExecuteExcel4Macro "PRINT(2,1,8,1,,FALSE,,,,,,2,,,TRUE,,FALSE)"
End Sub
Display More