VenkateshRajaganesan
New Member
- Joined
- May 27, 2022
- Messages
- 7
- Office Version
- 365
- 2011
This code is to consolidate, filter & delete some excepts, Insert, lookups with next sheet.
It is run when do with F8 but not work in F5.
It is run when do with F8 but not work in F5.
VBA Code:
Sub Evening_data()
Dim twb As Workbook
Dim tws As Worksheet
Dim Lrow As Long
Dim fil As Range
Set twb = ThisWorkbook
'Set tws = twb.Sheets("Report date")
Set TWS1 = twb.Sheets("Dashboard")
Set tws2 = twb.Sheets("Evening Allocation")
Set tws3 = twb.Sheets("Audit Merger")
Lrow = tws2.Range("A1")(Rows.Count, 1).End(xlUp).Row
tws2.Range("A:AI").AutoFilter Field:=3, Criteria1:=" ", Operator:=xlFilterValues
On Error Resume Next
tws2.Range("C2:C" & Lrow).SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeBlanks).Value = "UNMATCHED"
If ActiveSheet.AutoFilterMode Then Selection.AutoFilter
With tws2.Range("A:AI")
.AutoFilter Field:=3, Criteria1:="*i-*"
.AutoFilter Field:=21, Criteria1:="TAX"
.AutoFilter Field:=25, Criteria1:="<>0"
End With
On Error Resume Next
tws2.Range("y2:y" & Lrow).SpecialCells(xlCellTypeVisible).Font.Color = vbRed
'Selection.Font.Color = vbRed
If ActiveSheet.AutoFilterMode Then Selection.AutoFilter
tws2.Range("A:AI").Select
tws2.Range("A:AI").RemoveDuplicates Columns:=Array(4, 5, 9, 10, 11), Header:=xlYes
tws2.Range("G:H").EntireColumn.Delete
tws2.Range("N:N").EntireColumn.Delete
tws2.Range("I:I").EntireColumn.Insert
tws2.Range("N:N").EntireColumn.Insert
tws2.Range("I1").Value = "vlookupinv"
tws2.Range("N1").Value = "vlookupDCN"
'vlookups
Lrow = tws2.Range("A1")(Rows.Count, 1).End(xlUp).Row
'Invoice lookups
tws2.Range("I2").FormulaR1C1 = "=VLOOKUP(RC[-1],'Audit Merger'!C[-1],1,0)"
tws2.Range("I2").Copy
tws2.Range("I2:I" & Lrow).Select
Selection.PasteSpecial
Application.CutCopyMode = False
'DCN lookups
tws2.Range("N2").FormulaR1C1 = "=VLOOKUP(RC[-1],'Audit Merger'!C[-2],1,0)"
tws2.Range("N2").Copy
tws2.Range("N2:N" & Lrow).Select
Selection.PasteSpecial
Application.CutCopyMode = False
tws2.Range("J1").EntireColumn.Insert
tws2.Range("J1").Value = "T/F"
tws2.Range("J2").FormulaR1C1 = "=RC[-1]=RC[-2]"
tws2.Range("J2").Copy
tws2.Range("J2:J" & Lrow).Select
Selection.PasteSpecial
Application.CutCopyMode = False
tws2.Range("A:AI").AutoFilter Field:=10, Criteria1:="True", Operator:=xlFilterValues
tws2.Range("A1:AI50000").Offset(1, 0).SpecialCells(xlCellTypeVisible).Select
Application.Wait (Now + TimeValue("00:00:01"))
Selection.Delete Shift:=xlUp
If ActiveSheet.AutoFilterMode Then Selection.AutoFilter
Lrow = tws2.Range("A1")(Rows.Count, 1).End(xlUp).Row
tws2.Range("A1").Select
tws2.Range("P1").EntireColumn.Insert
tws2.Range("P1").Value = "T/F"
tws2.Range("P2").FormulaR1C1 = "=RC[-1]=RC[-2]"
tws2.Range("P2").Copy
tws2.Range("P2:P" & Lrow).Select
Selection.PasteSpecial
Application.CutCopyMode = False
tws2.Range("A:AI").AutoFilter Field:=16, Criteria1:="True", Operator:=xlFilterValues
tws2.Range("A1:AI50000").Offset(1, 0).SpecialCells(xlCellTypeVisible).Select
Application.Wait (Now + TimeValue("00:00:01"))
Selection.Delete Shift:=xlUp
If ActiveSheet.AutoFilterMode Then Selection.AutoFilter
tws2.Range("A1").Select
tws2.Range("I:J").EntireColumn.Delete
tws2.Range("M:N").EntireColumn.Delete
''Need to work from here
Lrow = tws2.Range("A1")(Rows.Count, 1).End(xlUp).Row
'filter-1
tws2.Range("A:AI").AutoFilter Field:=16, Criteria1:="*Max*", Operator:=xlFilterValues
tws2.Range("A1:AI" & Lrow).Offset(1, 0).SpecialCells(xlCellTypeVisible).Select
Application.Wait (Now + TimeValue("00:00:01"))
tws2.Range("A1:AI" & Lrow).Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
If ActiveSheet.AutoFilterMode Then Selection.AutoFilter
'filter-2
tws2.Range("P1").Select
tws2.Range("A:AI").AutoFilter Field:=16, Criteria1:="*ACH*", Operator:=xlFilterValues
tws2.Range("A1:AI" & Lrow).Offset(1, 0).SpecialCells(xlCellTypeVisible).Select
Application.Wait (Now + TimeValue("00:00:01"))
tws2.Range("A1:AI" & Lrow).Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
If ActiveSheet.AutoFilterMode Then Selection.AutoFilter
'filter-3
tws2.Range("P1").Select
tws2.Range("A:AI").AutoFilter Field:=16, Criteria1:="*Refund*", Operator:=xlFilterValues
tws2.Range("A1:AI" & Lrow).Offset(1, 0).SpecialCells(xlCellTypeVisible).Select
Application.Wait (Now + TimeValue("00:00:01"))
tws2.Range("A1:AI" & Lrow).Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
If ActiveSheet.AutoFilterMode Then Selection.AutoFilter
'filter-4
tws2.Range("P1").Select
tws2.Range("A:AI").AutoFilter Field:=16, Criteria1:="*TEMS*", Operator:=xlFilterValues
Application.Wait (Now + TimeValue("00:00:01"))
tws2.Range("A1:AI" & Lrow).Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
If ActiveSheet.AutoFilterMode Then Selection.AutoFilter
'filter-5
tws2.Range("P1").Select
tws2.Range("A:AI").AutoFilter Field:=16, Criteria1:="*KLB*", Operator:=xlFilterValues
tws2.Range("A1:AI" & Lrow).Offset(1, 0).SpecialCells(xlCellTypeVisible).Select
Application.Wait (Now + TimeValue("00:00:01"))
tws2.Range("A1:AI" & Lrow).Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
If ActiveSheet.AutoFilterMode Then Selection.AutoFilter
'filter-6
tws2.Range("P1").Select
tws2.Range("A:AI").AutoFilter Field:=16, Criteria1:="*KLR*", Operator:=xlFilterValues
tws2.Range("A1:AI" & Lrow).Offset(1, 0).SpecialCells(xlCellTypeVisible).Select
Application.Wait (Now + TimeValue("00:00:01"))
tws2.Range("A1:AI" & Lrow).Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
If ActiveSheet.AutoFilterMode Then Selection.AutoFilter
tws2.Range("P1").Select
'filter-7
tws2.Range("P1").Select
tws2.Range("A:AI").AutoFilter Field:=16, Criteria1:="*OMU*", Operator:=xlFilterValues
tws2.Range("A1:AI" & Lrow).Offset(1, 0).SpecialCells(xlCellTypeVisible).Select
Application.Wait (Now + TimeValue("00:00:01"))
tws2.Range("A1:AI" & Lrow).Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
If ActiveSheet.AutoFilterMode Then Selection.AutoFilter
Lrow = tws2.Range("A1")(Rows.Count, 1).End(xlUp).Row
tws2.Range("R:R").EntireColumn.Insert
tws2.Range("R1").Value = "Created By"
tws2.Range("R2").FormulaR1C1 = "=VLOOKUP(RC[-1],Dashboard!C[-6]:C[-5],2,0)"
tws2.Range("R2").Copy
tws2.Range("R2:R" & Lrow).Select
Selection.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
'Header
tws2.Range("Q1").Select
tws2.Range("Q:Q").EntireColumn.Delete
tws3.Range("A1:AH1").Select
tws3.Range("A1:AH1").Copy
tws2.Range("A1:AH1").EntireRow.Insert
tws2.Range("A2:AH2").EntireRow.Delete
MsgBox " Evening allocation file is ready"
End Sub
Last edited by a moderator: