Hi all. thanks you in advance for your help.
I am new at VBA and have been trying to compare 2 lists and add or delete records as needed. Both the lists are in tables of which I also need formulas added. Hopefully the detail below makes it easier to understand. Column B on this sheet is the list I am using on this sheet.
My first sheet called "INVEXT" is my master sheet generated everyday and has a comprehensive list of all inventory on hand. This is updated when the workbook is opened.
The other sheet is called Control. This is the sheet that the users can add information to. Column D is where the second list is.
What I am needing is the 2 lists to compare against each other, and data in INVEXT column B that is NOT in control Column D needs to be copied across to the Control sheet. Any data that is in column D on the control sheet that is NOT in INVEXT column A needs to be deleted from the control sheet.
Then I need the table to adjust to the length of the rows used. From there I should be able to use the code I have to insert the formulas into the table. The table in question also needs to be 50 columns wide starting from row D.
The code I am currently using is below, it is working to a degree but is extremely long and quite slow to run. I have seen a version quite a while ago that is almost instant to run regardless of how much data is used. Once again thank you very much in advance for any assistance any one may be able to give.
Sub UpdateControlPage()
'First part compares existing control sheet to most recent inventory list and adds any new products to the bottom of the list.
'Find Items to delete
Sheets("Home Page").Select
Sheets("Control").Visible = True
Sheets("Home Page").Select
ActiveWindow.SelectedSheets.Visible = False
Cells.Select
Range("C1").Activate
Selection.EntireColumn.Hidden = False
Range("E2").Select
Sheets("Control").Select
Sheets("Calculations").Visible = True
Selection.Copy
Application.CutCopyMode = False
Sheets("Control").Select
Columns("BH:BH").Select
Selection.ClearContents
Range("BH2").Select
Sheets("Calculations").Select
Range("M2").Select
Selection.Copy
Sheets("Control").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Set sh = Sheets("Control")
LR = sh.Rows(sh.UsedRange.Rows.Count).Row
Application.ScreenUpdating = False
For i = 1 To LR
If Cells(i, "BH") = "Delete" Then
sh.Cells(i, "D").Resize(, 3).ClearContents
sh.Cells(i, "D").Delete
'sh.Cells(i, "E").ClearContents
'sh.Cells(i, "L").ClearContents
'sh.Cells(i, "N").ClearContents
'sh.Cells(i, "O").ClearContents
'sh.Cells(i, "P").ClearContents
'sh.Cells(i, "R").ClearContents
'sh.Cells(i, "S").ClearContents
End If
Next i
Application.ScreenUpdating = True
Columns("Z:BH").Select
Range("BH1").Activate
Selection.EntireColumn.Hidden = True
Columns("A:B").Select
Selection.EntireColumn.Hidden = True
Sheets("Calculations").Select
ActiveWindow.SelectedSheets.Visible = False
Worksheets("Control").Activate
Cells.Select
Selection.EntireColumn.Hidden = False
Columns("A:C").Select
Selection.ClearContents
Dim vv As Variant, cc As Variant
With CreateObject("Scripting.Dictionary")
With Worksheets("Control")
vv = .Range("A2", .Range("A" & Rows.Count).End(xlUp)).Value
End With
For Each cc In vv
.Item(cc) = 1
Next cc
With Worksheets("INVEXT")
vv = .Range("B1", .Range("B" & Rows.Count).End(xlUp)).Value
End With
For Each cc In vv
.Item(cc) = 1
Next cc
Sheets("Control").Range("A2").Resize(.Count).Value = Application.Transpose(.keys)
End With
Worksheets("control").Columns("A:A").AutoFit
'List data not in Column D and show them in Column B
Columns("B:B").Select
Selection.ClearContents
Dim ListA As Range
Dim ListB As Range
Dim c As Range
Set ListA = Range("A:A")
Set ListB = Range("D:D")
For Each c In ListA
If c.Value <> "" Then
If Application.CountIf(ListB, c) = 0 Then
Cells(Cells(Rows.Count, "B").End(xlUp).Row + 1, "B").Value = c
End If
End If
Next c
For Each c In ListB
If c.Value <> "" Then
If Application.CountIf(ListA, c) = 0 Then
Cells(Cells(Rows.Count, "D").End(xlUp).Row + 1, "D").Value = c
End If
End If
Next c
'Below step removes Table From Control Sheet
Dim wks As Worksheet, objList As ListObject
Set wks = ActiveWorkbook.ActiveSheet
For Each objList In wks.ListObjects
objList.Unlist
Next objList
Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row).Select
Selection.Copy
'Find first empty cell at bottom of control list in column D ()4
Dim ws As Worksheet
Set ws = ActiveSheet
For Each cell In ws.Columns(4).Cells
If IsEmpty(cell) = True Then cell.Select: Exit For
Next cell
ActiveSheet.Paste
Worksheets("control").Columns("D:D").AutoFit
'Below step inserts table around around updated list
Range(Cells(1, 60), Cells(Rows.Count, 4).End(xlUp)).Select
Dim tbl As ListObject
Set tbl = ActiveSheet.ListObjects.Add(xlSrcRange, Selection, , xlYes)
tbl.TableStyle = "TableStyleLight1"
Columns("F:K").Select
Selection.ClearContents
Columns("M:M").Select
Selection.ClearContents
Columns("S:Y").Select
Selection.ClearContents
Columns("A:A").Hidden = False
'Insert top labels along columns and adds formulas to row 2
Worksheets("Control").Range("E1").Value = "Print Description"
Worksheets("Control").Range("F1").Value = "RRP"
Worksheets("Control").Range("F2").Formula = "=ROUND(VLOOKUP(D2,INVEXT!B:M,12,FALSE)*1.1,0)"
Worksheets("Control").Range("G1").Value = "SOH"
Worksheets("Control").Range("G2").Formula = "=VLOOKUP(D2,INVEXT!B:G,6,FALSE)"
Worksheets("Control").Range("H1").Value = "SOO"
Worksheets("Control").Range("H2").Formula = "=VLOOKUP(D2,INVEXT!B:H,7,FALSE)"
Worksheets("Control").Range("I1").Value = "AVAI"
Worksheets("Control").Range("I2").Formula = "=VLOOKUP(D2,INVEXT!B:K,10,FALSE)"
Worksheets("Control").Range("J1").Value = "UNAVAI"
Worksheets("Control").Range("J2").Formula = "=VLOOKUP(D2,INVEXT!B:J,9,FALSE)"
Worksheets("Control").Range("K1").Value = "Total Sellable"
Worksheets("Control").Range("K2").Formula = "=G2+H2-J2"
Worksheets("Control").Range("L1").Value = "Qty To Keep"
Worksheets("Control").Range("M1").Value = "Diff"
Worksheets("Control").Range("M2").Formula = "=(G2-L2)"
Worksheets("Control").Range("N1").Value = "Location"
Worksheets("Control").Range("O1").Value = "Requested"
Worksheets("Control").Range("p1").Value = "Keep/Clear"
Worksheets("Control").Range("Q1").Value = "RRP."
Worksheets("Control").Range("Q2").Formula = "=ROUND(VLOOKUP(D2,INVEXT!B:M,12,FALSE)*1.1,0)"
Worksheets("Control").Range("R1").Value = "Go Price"
Worksheets("Control").Range("S1").Value = "Cat Price"
Worksheets("Control").Range("T1").Value = "GP%"
Worksheets("Control").Range("T2").Formula = "=IF(Z2>=0,IF(R2>0,((R2-Z2)/R2),((Q2-Z2)/Q2)),0)" '=IFERROR(IF(N2>=0,IF(P2>0,((P2-N2)/P2),((O2-N2)/O2)),0),"")
Worksheets("Control").Range("U1").Value = "Hierachy"
Worksheets("Control").Range("U2").Formula = "=VLOOKUP(D2,INVEXT!B:C,2,FALSE)"
Worksheets("Control").Range("V1").Value = "DEPT"
Worksheets("Control").Range("V2").Formula = "=LEFT(U2,3)"
Worksheets("Control").Range("W1").Value = "GRP"
Worksheets("Control").Range("W2").Formula = "=MID(U2,4,3)"
Worksheets("Control").Range("X1").Value = "CAT"
Worksheets("Control").Range("X2").Formula = "=MID(U2,7,3)"
Worksheets("Control").Range("Y1").Value = "CLS"
Worksheets("Control").Range("Y2").Formula = "=MID(U2,10,3)"
Worksheets("Control").Range("Z1").Value = "AVG TAG"
Worksheets("Control").Range("Z2").Formula = "=VLOOKUP(d2,INVEXT!B:L,11,FALSE)/G2"
Worksheets("control").Columns("D:Z").AutoFit
'=IF(ISNA(VLOOKUP(D2,A:A,1,FALSE)),"Delete","")
'Below clears existing contents ready for update from auto columns ONLY
Columns("A:C").Select
Selection.EntireColumn.Hidden = True
Columns("Z").Select
Selection.EntireColumn.Hidden = True
Cells.Select
Range("D1").Activate
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Columns("D:Y").Select
Selection.EntireColumn.Hidden = False
Columns("C:C").Select
Selection.EntireColumn.Hidden = False
'Adjust column Width
Columns("C:C").ColumnWidth = 16.57
Columns("C:C").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Columns("AA:BH").Select
Selection.EntireColumn.Hidden = True
Range("E2").Select
End Sub
I am new at VBA and have been trying to compare 2 lists and add or delete records as needed. Both the lists are in tables of which I also need formulas added. Hopefully the detail below makes it easier to understand. Column B on this sheet is the list I am using on this sheet.
My first sheet called "INVEXT" is my master sheet generated everyday and has a comprehensive list of all inventory on hand. This is updated when the workbook is opened.
The other sheet is called Control. This is the sheet that the users can add information to. Column D is where the second list is.
What I am needing is the 2 lists to compare against each other, and data in INVEXT column B that is NOT in control Column D needs to be copied across to the Control sheet. Any data that is in column D on the control sheet that is NOT in INVEXT column A needs to be deleted from the control sheet.
Then I need the table to adjust to the length of the rows used. From there I should be able to use the code I have to insert the formulas into the table. The table in question also needs to be 50 columns wide starting from row D.
The code I am currently using is below, it is working to a degree but is extremely long and quite slow to run. I have seen a version quite a while ago that is almost instant to run regardless of how much data is used. Once again thank you very much in advance for any assistance any one may be able to give.
Sub UpdateControlPage()
'First part compares existing control sheet to most recent inventory list and adds any new products to the bottom of the list.
'Find Items to delete
Sheets("Home Page").Select
Sheets("Control").Visible = True
Sheets("Home Page").Select
ActiveWindow.SelectedSheets.Visible = False
Cells.Select
Range("C1").Activate
Selection.EntireColumn.Hidden = False
Range("E2").Select
Sheets("Control").Select
Sheets("Calculations").Visible = True
Selection.Copy
Application.CutCopyMode = False
Sheets("Control").Select
Columns("BH:BH").Select
Selection.ClearContents
Range("BH2").Select
Sheets("Calculations").Select
Range("M2").Select
Selection.Copy
Sheets("Control").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Set sh = Sheets("Control")
LR = sh.Rows(sh.UsedRange.Rows.Count).Row
Application.ScreenUpdating = False
For i = 1 To LR
If Cells(i, "BH") = "Delete" Then
sh.Cells(i, "D").Resize(, 3).ClearContents
sh.Cells(i, "D").Delete
'sh.Cells(i, "E").ClearContents
'sh.Cells(i, "L").ClearContents
'sh.Cells(i, "N").ClearContents
'sh.Cells(i, "O").ClearContents
'sh.Cells(i, "P").ClearContents
'sh.Cells(i, "R").ClearContents
'sh.Cells(i, "S").ClearContents
End If
Next i
Application.ScreenUpdating = True
Columns("Z:BH").Select
Range("BH1").Activate
Selection.EntireColumn.Hidden = True
Columns("A:B").Select
Selection.EntireColumn.Hidden = True
Sheets("Calculations").Select
ActiveWindow.SelectedSheets.Visible = False
Worksheets("Control").Activate
Cells.Select
Selection.EntireColumn.Hidden = False
Columns("A:C").Select
Selection.ClearContents
Dim vv As Variant, cc As Variant
With CreateObject("Scripting.Dictionary")
With Worksheets("Control")
vv = .Range("A2", .Range("A" & Rows.Count).End(xlUp)).Value
End With
For Each cc In vv
.Item(cc) = 1
Next cc
With Worksheets("INVEXT")
vv = .Range("B1", .Range("B" & Rows.Count).End(xlUp)).Value
End With
For Each cc In vv
.Item(cc) = 1
Next cc
Sheets("Control").Range("A2").Resize(.Count).Value = Application.Transpose(.keys)
End With
Worksheets("control").Columns("A:A").AutoFit
'List data not in Column D and show them in Column B
Columns("B:B").Select
Selection.ClearContents
Dim ListA As Range
Dim ListB As Range
Dim c As Range
Set ListA = Range("A:A")
Set ListB = Range("D:D")
For Each c In ListA
If c.Value <> "" Then
If Application.CountIf(ListB, c) = 0 Then
Cells(Cells(Rows.Count, "B").End(xlUp).Row + 1, "B").Value = c
End If
End If
Next c
For Each c In ListB
If c.Value <> "" Then
If Application.CountIf(ListA, c) = 0 Then
Cells(Cells(Rows.Count, "D").End(xlUp).Row + 1, "D").Value = c
End If
End If
Next c
'Below step removes Table From Control Sheet
Dim wks As Worksheet, objList As ListObject
Set wks = ActiveWorkbook.ActiveSheet
For Each objList In wks.ListObjects
objList.Unlist
Next objList
Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row).Select
Selection.Copy
'Find first empty cell at bottom of control list in column D ()4
Dim ws As Worksheet
Set ws = ActiveSheet
For Each cell In ws.Columns(4).Cells
If IsEmpty(cell) = True Then cell.Select: Exit For
Next cell
ActiveSheet.Paste
Worksheets("control").Columns("D:D").AutoFit
'Below step inserts table around around updated list
Range(Cells(1, 60), Cells(Rows.Count, 4).End(xlUp)).Select
Dim tbl As ListObject
Set tbl = ActiveSheet.ListObjects.Add(xlSrcRange, Selection, , xlYes)
tbl.TableStyle = "TableStyleLight1"
Columns("F:K").Select
Selection.ClearContents
Columns("M:M").Select
Selection.ClearContents
Columns("S:Y").Select
Selection.ClearContents
Columns("A:A").Hidden = False
'Insert top labels along columns and adds formulas to row 2
Worksheets("Control").Range("E1").Value = "Print Description"
Worksheets("Control").Range("F1").Value = "RRP"
Worksheets("Control").Range("F2").Formula = "=ROUND(VLOOKUP(D2,INVEXT!B:M,12,FALSE)*1.1,0)"
Worksheets("Control").Range("G1").Value = "SOH"
Worksheets("Control").Range("G2").Formula = "=VLOOKUP(D2,INVEXT!B:G,6,FALSE)"
Worksheets("Control").Range("H1").Value = "SOO"
Worksheets("Control").Range("H2").Formula = "=VLOOKUP(D2,INVEXT!B:H,7,FALSE)"
Worksheets("Control").Range("I1").Value = "AVAI"
Worksheets("Control").Range("I2").Formula = "=VLOOKUP(D2,INVEXT!B:K,10,FALSE)"
Worksheets("Control").Range("J1").Value = "UNAVAI"
Worksheets("Control").Range("J2").Formula = "=VLOOKUP(D2,INVEXT!B:J,9,FALSE)"
Worksheets("Control").Range("K1").Value = "Total Sellable"
Worksheets("Control").Range("K2").Formula = "=G2+H2-J2"
Worksheets("Control").Range("L1").Value = "Qty To Keep"
Worksheets("Control").Range("M1").Value = "Diff"
Worksheets("Control").Range("M2").Formula = "=(G2-L2)"
Worksheets("Control").Range("N1").Value = "Location"
Worksheets("Control").Range("O1").Value = "Requested"
Worksheets("Control").Range("p1").Value = "Keep/Clear"
Worksheets("Control").Range("Q1").Value = "RRP."
Worksheets("Control").Range("Q2").Formula = "=ROUND(VLOOKUP(D2,INVEXT!B:M,12,FALSE)*1.1,0)"
Worksheets("Control").Range("R1").Value = "Go Price"
Worksheets("Control").Range("S1").Value = "Cat Price"
Worksheets("Control").Range("T1").Value = "GP%"
Worksheets("Control").Range("T2").Formula = "=IF(Z2>=0,IF(R2>0,((R2-Z2)/R2),((Q2-Z2)/Q2)),0)" '=IFERROR(IF(N2>=0,IF(P2>0,((P2-N2)/P2),((O2-N2)/O2)),0),"")
Worksheets("Control").Range("U1").Value = "Hierachy"
Worksheets("Control").Range("U2").Formula = "=VLOOKUP(D2,INVEXT!B:C,2,FALSE)"
Worksheets("Control").Range("V1").Value = "DEPT"
Worksheets("Control").Range("V2").Formula = "=LEFT(U2,3)"
Worksheets("Control").Range("W1").Value = "GRP"
Worksheets("Control").Range("W2").Formula = "=MID(U2,4,3)"
Worksheets("Control").Range("X1").Value = "CAT"
Worksheets("Control").Range("X2").Formula = "=MID(U2,7,3)"
Worksheets("Control").Range("Y1").Value = "CLS"
Worksheets("Control").Range("Y2").Formula = "=MID(U2,10,3)"
Worksheets("Control").Range("Z1").Value = "AVG TAG"
Worksheets("Control").Range("Z2").Formula = "=VLOOKUP(d2,INVEXT!B:L,11,FALSE)/G2"
Worksheets("control").Columns("D:Z").AutoFit
'=IF(ISNA(VLOOKUP(D2,A:A,1,FALSE)),"Delete","")
'Below clears existing contents ready for update from auto columns ONLY
Columns("A:C").Select
Selection.EntireColumn.Hidden = True
Columns("Z").Select
Selection.EntireColumn.Hidden = True
Cells.Select
Range("D1").Activate
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Columns("D:Y").Select
Selection.EntireColumn.Hidden = False
Columns("C:C").Select
Selection.EntireColumn.Hidden = False
'Adjust column Width
Columns("C:C").ColumnWidth = 16.57
Columns("C:C").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Columns("AA:BH").Select
Selection.EntireColumn.Hidden = True
Range("E2").Select
End Sub
