Messy / slow code

[Billdub417]

Hello,
I have used a macro to check whether numbers are included in a list, and if not, add these to the bottom of said list.

However, the code i am using is quite slow / basic and i think it could be simplified - glad of any assistance.

thanks in advance,

Sub UpdateList()

    Sheets("Sheet2").Select
    Range("H1").Select
    ActiveCell.FormulaR1C1 = "=RC[-7]"
    Selection.AutoFill Destination:=Range("H1:H20"), Type:=xlFillDefault
    Sheets("Sheet1").Select
    Range("A2:A25").Select
    Selection.Copy
    Sheets("Sheet2").Select
    Range("H21").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("H1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    ActiveSheet.Range("$H$1:$H$55").RemoveDuplicates Columns:=1, Header:=xlNo
    Range("I1").Select
    ActiveCell.FormulaR1C1 = _
        "=IFNA(IF(RC[-1]<>"""",VLOOKUP(RC[-1],Sheet1!R2C1:R25C3,2,FALSE),""""),""Enter Ref"")"
    Range("I1").Select
    Selection.AutoFill Destination:=Range("I1:I55"), Type:=xlFillDefault
    Range("I1:I55").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("J1").Select
    ActiveCell.FormulaR1C1 = _
        "=IFNA(IF(RC[-2]<>"""",VLOOKUP(RC[-2],Sheet1!R2C1:R25C3,3,FALSE),""""),""Enter Ref"")"
    Range("J1").Select
    Selection.AutoFill Destination:=Range("J1:J55"), Type:=xlFillDefault
    Range("J1:J55").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Sheet1").Select
    Range("A2:c55").Select
    Selection.ClearContents
    Sheets("Sheet2").Select
    Range("H1:J1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Sheet1").Select
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Sheet2").Select
    Columns("H:K").Select
    Selection.ClearContents
    Sheets("Sheet1").Select
    Range("A1").Select
End Sub

 

[Fluff]

Are you trying to add the values from col A sheet2 to col A sheet1 if they do not already exist?

 

[Billdub417]

Are you trying to add the values from col A sheet2 to col A sheet1 if they do not already exist?

yes exactly that

 

[Fluff]

Ok, how about

Sub Billdub()
   Dim Dic As Object
   Dim Cl As Range
   
   Set Dic = CreateObject("scripting.dictionary")
   With Sheets("sheet2")
      For Each Cl In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
         Dic(Cl.Value) = Empty
      Next Cl
   End With
   With Sheets("sheet1")
      For Each Cl In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
         If Dic.Exists(Cl.Value) Then Dic.Remove Cl.Value
      Next Cl
   End With
   If Dic.Count > 0 Then
      Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(Dic.Count).Value = Application.Transpose(Dic.Keys)
   End If
End Sub

 

[Billdub417]

Ok, how about

Sub Billdub()
   Dim Dic As Object
   Dim Cl As Range
  
   Set Dic = CreateObject("scripting.dictionary")
   With Sheets("sheet2")
      For Each Cl In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
         Dic(Cl.Value) = Empty
      Next Cl
   End With
   With Sheets("sheet1")
      For Each Cl In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
         If Dic.Exists(Cl.Value) Then Dic.Remove Cl.Value
      Next Cl
   End With
   If Dic.Count > 0 Then
      Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(Dic.Count).Value = Application.Transpose(Dic.Keys)
   End If
End Sub

Genius, thanks.
Is there a way to adapt it so that any new numbers added on the list have a comment "Enter Ref" in Col B and Col C?

Doc1.xlsm
	A	B	C
1	List	Ref 1	Ref 2
2	1,034	Blue	Apple
3	679	Blue	Pear
4	2,868	Blue	Orange
5	6,609	Red	Apple
6	8,352	Green	Apple
7	190	Orange	Orange
8	7,536	Green	Apple
9	1,629	Red	Pear
10	43
11	8,978
12	613
13	1,805
14	8,037
15	9,276
Sheet1

 

[Fluff]

Yup like

Sub Billdub()
   Dim Dic As Object
   Dim Cl As Range
   
   Set Dic = CreateObject("scripting.dictionary")
   With Sheets("sheet2")
      For Each Cl In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
         Dic(Cl.Value) = Empty
      Next Cl
   End With
   With Sheets("sheet1")
      For Each Cl In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
         If Dic.Exists(Cl.Value) Then Dic.Remove Cl.Value
      Next Cl
   End With
   If Dic.Count > 0 Then
      With Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(Dic.Count)
         .Value = Application.Transpose(Dic.Keys)
         .Offset(, 1).Resize(, 2).Value = "Enter Ref"
      End With
   End If
End Sub

 

[Billdub417]

Yup like

Sub Billdub()
   Dim Dic As Object
   Dim Cl As Range
  
   Set Dic = CreateObject("scripting.dictionary")
   With Sheets("sheet2")
      For Each Cl In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
         Dic(Cl.Value) = Empty
      Next Cl
   End With
   With Sheets("sheet1")
      For Each Cl In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
         If Dic.Exists(Cl.Value) Then Dic.Remove Cl.Value
      Next Cl
   End With
   If Dic.Count > 0 Then
      With Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(Dic.Count)
         .Value = Application.Transpose(Dic.Keys)
         .Offset(, 1).Resize(, 2).Value = "Enter Ref"
      End With
   End If
End Sub

VMT!

 

[Fluff]

You're welcome & thanks for the feedback.