Trouble Shortening Macro to Run Faster

A

ab10

New Member
Joined
Aug 23, 2012
Messages
2
I am working with a list reconciliation tool that was put together on Windows 7 using Excel 2003. It works well for small amounts of data, however I would like it to be able to run through about 10,000 rows of data without slowing down significantly or even freezing up. Reviewing the macro VBL, I can tell most of it was coded by recording the macro resulting in a lot of unnecessary lines of code that ideally could be condensed/looped into just a few lines (with the same output) . I was wondering if someone could review these macros keeping in mind utilizing loops and logic and suggest ways to help condense the code to make them run faster. This code gives an output of each entry in the two lists along with the number of times each occurs.
This is the macro for finding repeats with an output of "digit (x times)":
Code: 
Sub ListRepeats()
    Dim Rng16 As Range
    Dim Rng18 As Range
    Dim Rng19 As Range
    LastRow = Cells(Rows.Count, "B").End(xlUp).Row
    LastRow2 = Cells(Rows.Count, "C").End(xlUp).Row
    Set Rng16 = Range("T2:T" & LastRow)
    Set Rng18 = Range("AA2:AA" & LastRow2)
    Set Rng19 = Range("V2:V" & LastRow2)
    Application.ScreenUpdating = False
    ActiveSheet.Unprotect Password:="password"
    Sheets("Sheet2").Unprotect Password:="password"
    Sheets("Sheet3").Unprotect Password:="password"
    Columns("D:R").Select
    Selection.EntireColumn.Hidden = True
    Range("W1").FormulaR1C1 = "Part Number"
    Range("W:X").ClearContents
    LastRowB = Range("B" & Rows.Count).End(xlUp).Row
    Range("B2:B" & LastRowB).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("W2"), Unique:=True
    LastRowF = Range("W" & Rows.Count).End(xlUp).Row
    With Range("W2:W" & LastRowF)
    .Sort Key1:=Range("W2"), Order1:=xlAscending, Header:=xlYes,  OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom,  DataOption1:=xlSortNormal
     With .Offset(, 1)
    .FormulaR1C1 = "=COUNTIF(R2C2:R" & LastRowB & "C2,RC[-1])"
    .Value = .Value
    .Cells(0).Value = "Occurrences"
     End With
    .Resize(, 2).EntireColumn.AutoFit
    End With
    
    Range("Y:Z").ClearContents
    LastRowE = Range("C" & Rows.Count).End(xlUp).Row
    Range("C2:C" & LastRowE).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("Y2"), Unique:=True
    LastRowC = Range("Y" & Rows.Count).End(xlUp).Row
    With Range("Y2:Y" & LastRowC)
    .Sort Key1:=Range("Y2"), Order1:=xlAscending, Header:=xlYes,  OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom,  DataOption1:=xlSortNormal
    With .Offset(, 1)
    .FormulaR1C1 = "=Countif(R2C2:R" & LastRowE & "C2, RC[-1])"
    .Value = .Value
    .Cells(0).Value = "Occurences"
    End With
    .Resize(, 2).EntireColumn.AutoFit
    End With
    
    ActiveWorkbook.Names.Add Name:="List1Repeats", RefersToR1C1:= _
        "=OFFSET(Sheet1!R2C29, 0, 0, COUNTA(Sheet1!C29), 1)"
    ActiveWorkbook.Names.Add Name:="List1Repeats", RefersToR1C1:= _
        "=OFFSET(Sheet1!R2C29, 0, 0, COUNTA(Sheet1!C29), 1)"

    ActiveWorkbook.Names.Add Name:="List2Repeats", RefersToR1C1:= _
        "=OFFSET(Sheet1!R2C27, 0, 0, COUNTA(Sheet1!C27), 1)"
    ActiveWorkbook.Names.Add Name:="List2Repeats", RefersToR1C1:= _
        "=OFFSET(Sheet1!R2C27, 0, 0, COUNTA(Sheet1!C27), 1)"
    
    Sheets("Sheet2").Select
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "=Sheet1!R[1]C[19] & "" ("""
    Range("D1").Select
    Selection.AutoFill Destination:=Range("D1:D" & LastRow), Type:=xlFillDefault
    Range("D1:D" & LastRow).Select
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "=VALUE(Sheet1!R[1]C[19])"
    Range("E1").Select
    Selection.AutoFill Destination:=Range("E1:E" & LastRow), Type:=xlFillDefault
    Range("E1:E" & LastRow).Select
    Range("F1").Select
    ActiveCell.FormulaR1C1 = "=RC[-1]&"" times)"""
    Range("F1").Select
    Selection.AutoFill Destination:=Range("F1:F" & LastRow), Type:=xlFillDefault
    Range("F1:F" & LastRow).Select
    Range("G1").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-2]>=2, RC[-3]&RC[-1], """")"
    Range("G1").Select
    Selection.AutoFill Destination:=Range("G1:G" & LastRow), Type:=xlFillDefault
    Range("G1:G" & LastRow).Select
    Range("H1").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-1]="""", R[1]C, RC[-1])"
    Range("H1").Select
    Selection.AutoFill Destination:=Range("H1:H" & LastRow), Type:=xlFillDefault
    Range("H1:H" & LastRow).Select
    Range("I1").Select
    ActiveCell.FormulaR1C1 = "=ISNUMBER(MATCH(RC[-1],R1C8:H0,0))"
    Range("I2").Select
    ActiveCell.FormulaR1C1 = "=ISNUMBER(MATCH(RC[-1],R1C8:R[-1]C[-1],0))"
    Range("I2").Select
    Selection.AutoFill Destination:=Range("I2:I" & LastRow), Type:=xlFillDefault
    Range("I2:I" & LastRow).Select
    Range("J1").Select
    ActiveCell.FormulaR1C1 = "=IF(AND( RC[-2]<>0, RC[-1]=FALSE), RC[-2], """")"
    Range("J1").Select
    Selection.AutoFill Destination:=Range("J1:J" & LastRow), Type:=xlFillDefault
    Range("J1:J" & LastRow).Select
    Sheets("Sheet1").Select
    
        Range("AC2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(AND(Sheet2!R[-1]C[-19]<>Sheet1!R[-1]C, Sheet2!R[-1]C[-19]<>""""), Sheet2!R[-1]C[-19], Sheet2!RC[-19])"
    Range("AC2").Select
    Selection.AutoFill Destination:=Range("AC2:AC" & LastRow), Type:=xlFillDefault
    Range("AC2:AC" & LastRow).Select
    Range("AD1").Select
    ActiveCell.FormulaR1C1 = "=COUNTIF(List1Repeats, ""*"")"
    Range("AD2").Select
    Selection.FormulaArray = _
         "=IF(ROWS(R1C29:R[-1]C[-1])>R1C30,"""",INDEX(List1Repeats,SMALL(IF(List1Repeats<>"""",ROW(List1Repeats)-ROW(R2C7)+1),ROWS(R1C29:R[-1]C[-1]))))"
    Selection.AutoFill Destination:=Range("AD2:AD" & LastRow), Type:=xlFillDefault
    Range("AD2:AD" & LastRow).Select
    Range("T2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(ISERROR(IF(RC[10]=""#NUM!"", """", RC[10])), """", RC[10])"
    Range("T2").Select
    Selection.AutoFill Destination:=Rng16, Type:=xlFillDefault
    Rng16.Select
    
    Sheets("Sheet3").Select
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "=Sheet1!R[1]C[21] & "" ("""
    Range("D1").Select
    Selection.AutoFill Destination:=Range("D1:D" & LastRow2), Type:=xlFillDefault
    Range("D1:D" & LastRow2).Select
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "=VALUE(Sheet1!R[1]C[21])"
    Range("E1").Select
    Selection.AutoFill Destination:=Range("E1:E" & LastRow2), Type:=xlFillDefault
    Range("E1:E" & LastRow2).Select
    Range("F1").Select
    ActiveCell.FormulaR1C1 = "=RC[-1]&"" times)"""
    Range("F1").Select
    Selection.AutoFill Destination:=Range("F1:F" & LastRow2), Type:=xlFillDefault
    Range("F1:F" & LastRow2).Select
    Range("G1").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-2]>=2, RC[-3]&RC[-1], """")"
    Range("G1").Select
    Selection.AutoFill Destination:=Range("G1:G" & LastRow2), Type:=xlFillDefault
    Range("G1:G" & LastRow2).Select
    Range("H1").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-1]="""", R[1]C, RC[-1])"
    Range("H1").Select
    Selection.AutoFill Destination:=Range("H1:H" & LastRow2), Type:=xlFillDefault
    Range("H1:H" & LastRow2).Select
    Range("I1").Select
    ActiveCell.FormulaR1C1 = "=ISNUMBER(MATCH(RC[-1],R1C8:H0,0))"
    Range("I2").Select
    ActiveCell.FormulaR1C1 = "=ISNUMBER(MATCH(RC[-1],R1C8:R[-1]C[-1],0))"
    Range("I2").Select
    Selection.AutoFill Destination:=Range("I2:I" & LastRow2), Type:=xlFillDefault
    Range("I2:I" & LastRow2).Select
    Range("J1").Select
    ActiveCell.FormulaR1C1 = "=IF(AND( RC[-2]<>0, RC[-1]=FALSE), RC[-2], """")"
    Range("J1").Select
    Selection.AutoFill Destination:=Range("J1:J" & LastRow2), Type:=xlFillDefault
    Range("J1:J" & LastRow2).Select
    Sheets("Sheet1").Select
    
    Range("AA2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(AND(Sheet3!R[-1]C[-17]<>Sheet1!R[-1]C, Sheet3!R[-1]C[-17]<>""""), Sheet3!R[-1]C[-17], Sheet3!RC[-17])"
    Range("AA2").Select
    Selection.AutoFill Destination:=Rng18, Type:=xlFillDefault
    Rng18.Select
    Range("AB2").Select
    ActiveCell.FormulaR1C1 = "=COUNTIF(List2Repeats, ""*"")"
    Range("AB3").Select
    Selection.FormulaArray = _
         "=IF(ROWS(R1C27:R[-2]C[-1])>R2C28,"""",INDEX(List2Repeats,SMALL(IF(List2Repeats<>"""",ROW(List2Repeats)-ROW(R2C7)+1),ROWS(R1C27:R[-2]C[-1]))))"
    Selection.AutoFill Destination:=Range("AB3:AB" & LastRow2), Type:=xlFillDefault
    Range("AB3:AB" & LastRow2).Select
    Range("V2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(ISERROR(IF(R[1]C[6]=""#NUM!"", """", R[1]C[6])), """", R[1]C[6])"
    Range("V2").Select
    Selection.AutoFill Destination:=Rng19, Type:=xlFillDefault
    Rng19.Select
    
    Columns("W:AD").Select
    Selection.EntireColumn.Hidden = True
    Range("B2").Select
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    Sheets("Sheet2").Protect Password:="password", DrawingObjects:=True, Contents:=True, Scenarios:=True
    Sheets("Sheet3").Protect Password:="password", DrawingObjects:=True, Contents:=True, Scenarios:=True
    ActiveSheet.Protect Password:="password", DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

This is the macro that reconciles the two lists:

Code: 
Sub ReconcileListsSeparate()
 Application.ScreenUpdating = False
    ActiveSheet.Unprotect Password:="password"
    Sheets("Sheet2").Unprotect Password:="password"
    Sheets("Sheet3").Unprotect Password:="password"
    Columns("D:R").Select
    Selection.EntireColumn.Hidden = True
    Dim i, LastRowA, LastRowF
    Dim LastRowC, LastRowE
    Dim LastRow As Long
    Dim Rng1 As Range
    Dim Rng2 As Range
    Dim Rng3 As Range
    Dim Rng4 As Range
    Dim Rng5 As Range
    Dim Rng6 As Range
    Dim Rng7 As Range
    Dim Rng8 As Range
    Dim Rng9 As Range
    Dim Rng10 As Range
    Dim Rng11 As Range
    Dim Rng12 As Range
    Dim Rng13 As Range
    Dim Rng14 As Range
    Dim Rng15 As Range
    Dim Rng16 As Range
    Dim Rng17 As Range
    Dim Rng18 As Range
    LastRow = Cells(Rows.Count, "B").End(xlUp).Row
    LastRow2 = Cells(Rows.Count, "C").End(xlUp).Row
    Set Rng1 = Range("D2:D" & LastRow)
    Set Rng2 = Range("E2:E" & LastRow2)
    Set Rng3 = Range("F2:F" & LastRow)
    Set Rng4 = Range("G2:G" & LastRow2)
    Set Rng5 = Range("H2:H" & LastRow)
    Set Rng6 = Range("I2:I" & LastRow2)
    Set Rng7 = Range("K2:K" & LastRow)
    Set Rng8 = Range("L2:L" & LastRow)
    Set Rng9 = Range("M2:M" & LastRow)
    Set Rng10 = Range("N2:N" & LastRow)
    Set Rng11 = Range("O2:O" & LastRow2)
    Set Rng12 = Range("P2:P" & LastRow2)
    Set Rng13 = Range("Q2:Q" & LastRow2)
    Set Rng14 = Range("R2:R" & LastRow2)
    Set Rng15 = Range("S2:S" & LastRow)
    Set Rng16 = Range("T2:T" & LastRow)
    Set Rng17 = Range("U2:U" & LastRow2)
    Set Rng18 = Range("AA2:AA" & LastRow2)
    Set Rng19 = Range("V2:V" & LastRow2)
    
    Range("D2").Select
    ActiveCell.FormulaR1C1 = "=ISNUMBER(MATCH(RC[-2],C[-1], 0))"
    Range("D2").Select
    Selection.AutoFill Destination:=Rng1, Type:=xlFillDefault
    Rng1.Select

    Range("E2").Select
    ActiveCell.FormulaR1C1 = "=ISNUMBER(MATCH(RC[-2],C[-3], 0))"
    Range("E2").Select
    Selection.AutoFill Destination:=Rng2, Type:=xlFillDefault
    Rng2.Select

    Range("F2").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-2]=FALSE, RC[-4], """")"
    Range("F2").Select
    Selection.AutoFill Destination:=Rng3, Type:=xlFillDefault
    Rng3.Select

    Range("G2").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-2]=FALSE, RC[-4], """")"
    Range("G2").Select
    Selection.AutoFill Destination:=Rng4, Type:=xlFillDefault
    Rng4.Select

    ActiveWorkbook.Names.Add Name:="List1Only", RefersToR1C1:= _
        "=OFFSET(Sheet1!R2C6, 0, 0, COUNTA(Sheet1!C6), 1)"
    ActiveWorkbook.Names.Add Name:="List2Only", RefersToR1C1:= _
        "=OFFSET(Sheet1!R2C7, 0, 0, COUNTA(Sheet1!C7), 1)"
    ActiveWorkbook.Names.Add Name:="List2Only", RefersToR1C1:= _
        "=OFFSET(Sheet1!R2C7, 0, 0, COUNTA(Sheet1!C7), 1)"
    ActiveWindow.ScrollRow = 1
    Range("J2").Select
    ActiveCell.FormulaR1C1 = "=CountA(List1Only) - COUNTIF(List1Only, ""*"")"
    Range("J3").Select
    ActiveCell.FormulaR1C1 = "=CountA(List2Only) - COUNTIF(List2Only, ""*"")"
    Range("H2").Select
    Selection.FormulaArray = _
         "=IF(ROWS(R1C4:R[-1]C[-4])>R2C10,"""",INDEX(List1Only,SMALL(IF(List1Only<>"""",ROW(List1Only)-ROW(R2C6)+1),ROWS(R1C4:R[-1]C[-4]))))"
    Selection.AutoFill Destination:=Rng5, Type:=xlFillDefault
    Rng5.Select

    Range("I2").Select
    Selection.FormulaArray = _
         "=IF(ROWS(R1C5:R[-1]C[-4])>R3C10,"""",INDEX(List2Only,SMALL(IF(List2Only<>"""",ROW(List2Only)-ROW(R2C7)+1),ROWS(R1C5:R[-1]C[-4]))))"
    Selection.AutoFill Destination:=Rng6, Type:=xlFillDefault
    Rng6.Select
    
    Range("S2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(ISERROR(IF(RC[-11]=""#NUM!"", """", RC[-11])), """", RC[-11])"
    Range("S2").Select
    Selection.AutoFill Destination:=Rng15, Type:=xlFillDefault
    Rng15.Select
    
   
    Range("U2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(ISERROR(IF(RC[-12]=""#NUM!"", """", RC[-12])), """", RC[-12])"
    Range("U2").Select
    Selection.AutoFill Destination:=Rng17, Type:=xlFillDefault
    Rng17.Select
    
    
    Columns("W:AD").Select
    Selection.EntireColumn.Hidden = True
    Range("B2").Select
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    Sheets("Sheet2").Protect Password:="password", DrawingObjects:=True, Contents:=True, Scenarios:=True
    Sheets("Sheet3").Protect Password:="password", DrawingObjects:=True, Contents:=True, Scenarios:=True
    ActiveSheet.Protect Password:="password", DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

Finally, here is what the tool looks like:
3Jex5.jpg
[/IMG]
 
Last edited:

Excel Facts

Can Excel fill bagel flavors?
You can teach Excel a new custom list. Type the list in cells, File, Options, Advanced, Edit Custom Lists, Import, OK
Sort by date Sort by votes
one thing that will slow down your code are the selects. Things like this

Code: 
 Range("D1").Select
    ActiveCell.FormulaR1C1 = "=Sheet1!R[1]C[21] & "" ("""
[B]can become[/B]
 Range("D1").FormulaR1C1 = "=Sheet1!R[1]C[21] & "" ("""

and delete these lines

ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
 
Last edited:
Upvote 0
Thanks for the quick response!! I made a ton of edits based off your suggestions but it still is running extremely slow. Do you see anything else that could be edited/condensed? Here are the edited macros (I didnt delete anything, the lines I wanted to edit I made comments. The newly edited line is below the comments):
Sub ListRepeats()
Dim Rng16 As Range
Dim Rng18 As Range
Dim Rng19 As Range
LastRow = Cells(Rows.Count, "B").End(xlUp).Row
LastRow2 = Cells(Rows.Count, "C").End(xlUp).Row
Set Rng16 = Range("T2:T" & LastRow)
Set Rng18 = Range("AA2:AA" & LastRow2)
Set Rng19 = Range("V2:V" & LastRow2)
Application.ScreenUpdating = False
ActiveSheet.Unprotect Password:="pw"
Sheets("Sheet2").Unprotect Password:="pw"
Sheets("Sheet3").Unprotect Password:="pw"
'Columns("D:R").Select
'Selection.EntireColumn.Hidden = True
Columns("D:R").EntireColumn.Hidden = True
Range("W1").FormulaR1C1 = "Part Number"
Range("W:X").ClearContents
LastRowB = Range("B" & Rows.Count).End(xlUp).Row
Range("B2:B" & LastRowB).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("W2"), Unique:=True
LastRowF = Range("W" & Rows.Count).End(xlUp).Row
With Range("W2:W" & LastRowF)
.Sort Key1:=Range("W2"), Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
With .Offset(, 1)
.FormulaR1C1 = "=COUNTIF(R2C2:R" & LastRowB & "C2,RC[-1])"
.Value = .Value
.Cells(0).Value = "Occurrences"
End With
.Resize(, 2).EntireColumn.AutoFit
End With

Range("Y:Z").ClearContents
LastRowE = Range("C" & Rows.Count).End(xlUp).Row
Range("C2:C" & LastRowE).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("Y2"), Unique:=True
LastRowC = Range("Y" & Rows.Count).End(xlUp).Row
With Range("Y2:Y" & LastRowC)
.Sort Key1:=Range("Y2"), Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
With .Offset(, 1)
.FormulaR1C1 = "=Countif(R2C2:R" & LastRowE & "C2, RC[-1])"
.Value = .Value
.Cells(0).Value = "Occurences"
End With
.Resize(, 2).EntireColumn.AutoFit
End With

ActiveWorkbook.Names.Add Name:="List1Repeats", RefersToR1C1:= _
"=OFFSET(Sheet1!R2C29, 0, 0, COUNTA(Sheet1!C29), 1)"
ActiveWorkbook.Names.Add Name:="List1Repeats", RefersToR1C1:= _
"=OFFSET(Sheet1!R2C29, 0, 0, COUNTA(Sheet1!C29), 1)"

ActiveWorkbook.Names.Add Name:="List2Repeats", RefersToR1C1:= _
"=OFFSET(Sheet1!R2C27, 0, 0, COUNTA(Sheet1!C27), 1)"
ActiveWorkbook.Names.Add Name:="List2Repeats", RefersToR1C1:= _
"=OFFSET(Sheet1!R2C27, 0, 0, COUNTA(Sheet1!C27), 1)"

Sheets("Sheet2").Select
'Range("D1").Select
'ActiveCell.FormulaR1C1 = "=Sheet1!R[1]C[19] & "" ("""
Range("D1").FormulaR1C1 = "=Sheet1!R[1]C[19] & "" ("""
'Range("D1").Select
'Selection.AutoFill Destination:=Range("D1:D" & LastRow), Type:=xlFillDefault
Range("D1").AutoFill Destination:=Range("D1:D" & LastRow), Type:=xlFillDefault
Range("D1:D" & LastRow).Select
'Range("E1").Select
'ActiveCell.FormulaR1C1 = "=VALUE(Sheet1!R[1]C[19])"
Range("E1").FormulaR1C1 = "=VALUE(Sheet1!R[1]C[19])"
'Range("E1").Select
Range("E1").AutoFill Destination:=Range("E1:E" & LastRow), Type:=xlFillDefault
Range("E1:E" & LastRow).Select
'Range("F1").Select
'ActiveCell.FormulaR1C1 = "=RC[-1]&"" times)"""
Range("F1").FormulaR1C1 = "=RC[-1]&"" times)"""
'Range("F1").Select
Range("F1").AutoFill Destination:=Range("F1:F" & LastRow), Type:=xlFillDefault
Range("F1:F" & LastRow).Select
'Range("G1").Select
'ActiveCell.FormulaR1C1 = "=IF(RC[-2]>=2, RC[-3]&RC[-1], """")"
Range("G1").FormulaR1C1 = "=IF(RC[-2]>=2, RC[-3]&RC[-1], """")"
'Range("G1").Select
'Selection.AutoFill Destination:=Range("G1:G" & LastRow), Type:=xlFillDefault
Range("G1").AutoFill Destination:=Range("G1:G" & LastRow), Type:=xlFillDefault
Range("G1:G" & LastRow).Select
'Range("H1").Select
'ActiveCell.FormulaR1C1 = "=IF(RC[-1]="""", R[1]C, RC[-1])"
Range("H1").FormulaR1C1 = "=IF(RC[-1]="""", R[1]C, RC[-1])"
'Range("H1").Select
'Selection.AutoFill Destination:=Range("H1:H" & LastRow), Type:=xlFillDefault
Range("H1").AutoFill Destination:=Range("H1:H" & LastRow), Type:=xlFillDefault
Range("H1:H" & LastRow).Select
'Range("I1").Select
' ActiveCell.FormulaR1C1 = "=ISNUMBER(MATCH(RC[-1],R1C8:H0,0))"
Range("I1").FormulaR1C1 = "=ISNUMBER(MATCH(RC[-1],R1C8:H0,0))"
'Range("I2").Select
'ActiveCell.FormulaR1C1 = "=ISNUMBER(MATCH(RC[-1],R1C8:R[-1]C[-1],0))"
Range("I2").FormulaR1C1 = "=ISNUMBER(MATCH(RC[-1],R1C8:R[-1]C[-1],0))"
'Range("I2").Select
'Selection.AutoFill Destination:=Range("I2:I" & LastRow), Type:=xlFillDefault
Range("I2").AutoFill Destination:=Range("I2:I" & LastRow), Type:=xlFillDefault
Range("I2:I" & LastRow).Select
'Range("J1").Select
'ActiveCell.FormulaR1C1 = "=IF(AND( RC[-2]<>0, RC[-1]=FALSE), RC[-2], """")"
Range("J1").FormulaR1C1 = "=IF(AND( RC[-2]<>0, RC[-1]=FALSE), RC[-2], """")"
'Range("J1").Select
'Selection.AutoFill Destination:=Range("J1:J" & LastRow), Type:=xlFillDefault
Range("J1").AutoFill Destination:=Range("J1:J" & LastRow), Type:=xlFillDefault
Range("J1:J" & LastRow).Select
Sheets("Sheet1").Select

'Range("AC2").Select
'ActiveCell.FormulaR1C1 = _
"=IF(AND(Sheet2!R[-1]C[-19]<>Sheet1!R[-1]C, Sheet2!R[-1]C[-19]<>""""), Sheet2!R[-1]C[-19], Sheet2!RC[-19])"
Range("AC2").FormulaR1C1 = _
"=IF(AND(Sheet2!R[-1]C[-19]<>Sheet1!R[-1]C, Sheet2!R[-1]C[-19]<>""""), Sheet2!R[-1]C[-19], Sheet2!RC[-19])"
'Range("AC2").Select
'Selection.AutoFill Destination:=Range("AC2:AC" & LastRow), Type:=xlFillDefault
Range("AC2").AutoFill Destination:=Range("AC2:AC" & LastRow), Type:=xlFillDefault
Range("AC2:AC" & LastRow).Select
'Range("AD1").Select
'ActiveCell.FormulaR1C1 = "=COUNTIF(List1Repeats, ""*"")"
Range("AD1").FormulaR1C1 = "=COUNTIF(List1Repeats, ""*"")"
'Range("AD2").Select
'Selection.FormulaArray = _
"=IF(ROWS(R1C29:R[-1]C[-1])>R1C30,"""",INDEX(List1Repeats,SMALL(IF(List1Repeats<>"""",ROW(List1Repeats)-ROW(R2C7)+1),ROWS(R1C29:R[-1]C[-1]))))"
Range("AD2").FormulaArray = _
"=IF(ROWS(R1C29:R[-1]C[-1])>R1C30,"""",INDEX(List1Repeats,SMALL(IF(List1Repeats<>"""",ROW(List1Repeats)-ROW(R2C7)+1),ROWS(R1C29:R[-1]C[-1]))))"
'Selection.AutoFill Destination:=Range("AD2:AD" & LastRow), Type:=xlFillDefault
Range("AD2").AutoFill Destination:=Range("AD2:AD" & LastRow), Type:=xlFillDefault
Range("AD2:AD" & LastRow).Select
'Range("T2").Select
'ActiveCell.FormulaR1C1 = _
"=IF(ISERROR(IF(RC[10]=""#NUM!"", """", RC[10])), """", RC[10])"
Range("T2").FormulaR1C1 = _
"=IF(ISERROR(IF(RC[10]=""#NUM!"", """", RC[10])), """", RC[10])"
'Range("T2").Select
'Selection.AutoFill Destination:=Rng16, Type:=xlFillDefault
Range("T2").AutoFill Destination:=Rng16, Type:=xlFillDefault
Rng16.Select

Sheets("Sheet3").Select
'Range("D1").Select
'ActiveCell.FormulaR1C1 = "=Sheet1!R[1]C[21] & "" ("""
Range("D1").FormulaR1C1 = "=Sheet1!R[1]C[21] & "" ("""
'Range("D1").Select
'Selection.AutoFill Destination:=Range("D1:D" & LastRow2), Type:=xlFillDefault
Range("D1").AutoFill Destination:=Range("D1:D" & LastRow2), Type:=xlFillDefault
Range("D1:D" & LastRow2).Select
'Range("E1").Select
'ActiveCell.FormulaR1C1 = "=VALUE(Sheet1!R[1]C[21])"
Range("E1").FormulaR1C1 = "=VALUE(Sheet1!R[1]C[21])"
'Range("E1").Select
'Selection.AutoFill Destination:=Range("E1:E" & LastRow2), Type:=xlFillDefault
Range("E1").AutoFill Destination:=Range("E1:E" & LastRow2), Type:=xlFillDefault
Range("E1:E" & LastRow2).Select
'Range("F1").Select
'ActiveCell.FormulaR1C1 = "=RC[-1]&"" times)"""
Range("F1").FormulaR1C1 = "=RC[-1]&"" times)"""
'Range("F1").Select
'Selection.AutoFill Destination:=Range("F1:F" & LastRow2), Type:=xlFillDefault
Range("F1").AutoFill Destination:=Range("F1:F" & LastRow2), Type:=xlFillDefault
Range("F1:F" & LastRow2).Select
'Range("G1").Select
'ActiveCell.FormulaR1C1 = "=IF(RC[-2]>=2, RC[-3]&RC[-1], """")"
Range("G1").FormulaR1C1 = "=IF(RC[-2]>=2, RC[-3]&RC[-1], """")"
'Range("G1").Select
'Selection.AutoFill Destination:=Range("G1:G" & LastRow2), Type:=xlFillDefault
Range("G1").AutoFill Destination:=Range("G1:G" & LastRow2), Type:=xlFillDefault
Range("G1:G" & LastRow2).Select
'Range("H1").Select
'ActiveCell.FormulaR1C1 = "=IF(RC[-1]="""", R[1]C, RC[-1])"
Range("H1").FormulaR1C1 = "=IF(RC[-1]="""", R[1]C, RC[-1])"
'Range("H1").Select
'Selection.AutoFill Destination:=Range("H1:H" & LastRow2), Type:=xlFillDefault
Range("H1").AutoFill Destination:=Range("H1:H" & LastRow2), Type:=xlFillDefault
Range("H1:H" & LastRow2).Select
'Range("I1").Select
'ActiveCell.FormulaR1C1 = "=ISNUMBER(MATCH(RC[-1],R1C8:H0,0))"
Range("I1").FormulaR1C1 = "=ISNUMBER(MATCH(RC[-1],R1C8:H0,0))"
'Range("I2").Select
'ActiveCell.FormulaR1C1 = "=ISNUMBER(MATCH(RC[-1],R1C8:R[-1]C[-1],0))"
Range("I2").FormulaR1C1 = "=ISNUMBER(MATCH(RC[-1],R1C8:R[-1]C[-1],0))"
'Range("I2").Select
'Selection.AutoFill Destination:=Range("I2:I" & LastRow2), Type:=xlFillDefault
Range("I2").AutoFill Destination:=Range("I2:I" & LastRow2), Type:=xlFillDefault
Range("I2:I" & LastRow2).Select
'Range("J1").Select
'ActiveCell.FormulaR1C1 = "=IF(AND( RC[-2]<>0, RC[-1]=FALSE), RC[-2], """")"
Range("J1").FormulaR1C1 = "=IF(AND( RC[-2]<>0, RC[-1]=FALSE), RC[-2], """")"
'Range("J1").Select
'Selection.AutoFill Destination:=Range("J1:J" & LastRow2), Type:=xlFillDefault
Range("J1").AutoFill Destination:=Range("J1:J" & LastRow2), Type:=xlFillDefault
Range("J1:J" & LastRow2).Select
Sheets("Sheet1").Select

'Range("AA2").Select
'ActiveCell.FormulaR1C1 = _
"=IF(AND(Sheet3!R[-1]C[-17]<>Sheet1!R[-1]C, Sheet3!R[-1]C[-17]<>""""), Sheet3!R[-1]C[-17], Sheet3!RC[-17])"
Range("AA2").FormulaR1C1 = _
"=IF(AND(Sheet3!R[-1]C[-17]<>Sheet1!R[-1]C, Sheet3!R[-1]C[-17]<>""""), Sheet3!R[-1]C[-17], Sheet3!RC[-17])"
'Range("AA2").Select
'Selection.AutoFill Destination:=Rng18, Type:=xlFillDefault
Range("AA2").AutoFill Destination:=Rng18, Type:=xlFillDefault
Rng18.Select
'Range("AB2").Select
'ActiveCell.FormulaR1C1 = "=COUNTIF(List2Repeats, ""*"")"
Range("AB2").FormulaR1C1 = "=COUNTIF(List2Repeats, ""*"")"
'Range("AB3").Select
'Selection.FormulaArray = _
"=IF(ROWS(R1C27:R[-2]C[-1])>R2C28,"""",INDEX(List2Repeats,SMALL(IF(List2Repeats<>"""",ROW(List2Repeats)-ROW(R2C7)+1),ROWS(R1C27:R[-2]C[-1]))))"
Range("AB3").FormulaArray = _
"=IF(ROWS(R1C27:R[-2]C[-1])>R2C28,"""",INDEX(List2Repeats,SMALL(IF(List2Repeats<>"""",ROW(List2Repeats)-ROW(R2C7)+1),ROWS(R1C27:R[-2]C[-1]))))"
'Selection.AutoFill Destination:=Range("AB3:AB" & LastRow2), Type:=xlFillDefault
Range("AB3").AutoFill Destination:=Range("AB3:AB" & LastRow2), Type:=xlFillDefault
Range("AB3:AB" & LastRow2).Select
'Range("V2").Select
'ActiveCell.FormulaR1C1 = _
"=IF(ISERROR(IF(R[1]C[6]=""#NUM!"", """", R[1]C[6])), """", R[1]C[6])"
Range("V2").FormulaR1C1 = _
"=IF(ISERROR(IF(R[1]C[6]=""#NUM!"", """", R[1]C[6])), """", R[1]C[6])"
'Range("V2").Select
'Selection.AutoFill Destination:=Rng19, Type:=xlFillDefault
Range("V2").AutoFill Destination:=Rng19, Type:=xlFillDefault
Rng19.Select

'Columns("W:AD").Select
'Selection.EntireColumn.Hidden = True
Columns("W:AD").EntireColumn.Hidden = True
Range("B2").Select
'ActiveWindow.ScrollColumn = 2
'ActiveWindow.ScrollColumn = 1
Sheets("Sheet2").Protect Password:="pw", DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("Sheet3").Protect Password:="pw", DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveSheet.Protect Password:="pw", DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub
Click to expand...

Sub ReconcileListsSeparate()
Application.ScreenUpdating = False
ActiveSheet.Unprotect Password:="pw"
Sheets("Sheet2").Unprotect Password:="pw"
Sheets("Sheet3").Unprotect Password:="pw"
'Columns("D:R").Select
'Selection.EntireColumn.Hidden = True
Columns("D:R").EntireColumn.Hidden = True
Dim i, LastRowA, LastRowF
Dim LastRowC, LastRowE
Dim LastRow As Long
Dim Rng1 As Range
Dim Rng2 As Range
Dim Rng3 As Range
Dim Rng4 As Range
Dim Rng5 As Range
Dim Rng6 As Range
Dim Rng7 As Range
Dim Rng8 As Range
Dim Rng9 As Range
Dim Rng10 As Range
Dim Rng11 As Range
Dim Rng12 As Range
Dim Rng13 As Range
Dim Rng14 As Range
Dim Rng15 As Range
Dim Rng16 As Range
Dim Rng17 As Range
Dim Rng18 As Range
LastRow = Cells(Rows.Count, "B").End(xlUp).Row
LastRow2 = Cells(Rows.Count, "C").End(xlUp).Row
Set Rng1 = Range("D2:D" & LastRow)
Set Rng2 = Range("E2:E" & LastRow2)
Set Rng3 = Range("F2:F" & LastRow)
Set Rng4 = Range("G2:G" & LastRow2)
Set Rng5 = Range("H2:H" & LastRow)
Set Rng6 = Range("I2:I" & LastRow2)
Set Rng7 = Range("K2:K" & LastRow)
Set Rng8 = Range("L2:L" & LastRow)
Set Rng9 = Range("M2:M" & LastRow)
Set Rng10 = Range("N2:N" & LastRow)
Set Rng11 = Range("O2:O" & LastRow2)
Set Rng12 = Range("P2:P" & LastRow2)
Set Rng13 = Range("Q2:Q" & LastRow2)
Set Rng14 = Range("R2:R" & LastRow2)
Set Rng15 = Range("S2:S" & LastRow)
Set Rng16 = Range("T2:T" & LastRow)
Set Rng17 = Range("U2:U" & LastRow2)
Set Rng18 = Range("AA2:AA" & LastRow2)
Set Rng19 = Range("V2:V" & LastRow2)

'Range("D2").Select
'ActiveCell.FormulaR1C1 = "=ISNUMBER(MATCH(RC[-2],C[-1], 0))"
Range("D2").FormulaR1C1 = "=ISNUMBER(MATCH(RC[-2],C[-1], 0))"
'Range("D2").Select
'Selection.AutoFill Destination:=Rng1, Type:=xlFillDefault
Range("D2").AutoFill Destination:=Rng1, Type:=xlFillDefault
Rng1.Select

'Range("E2").Select
'ActiveCell.FormulaR1C1 = "=ISNUMBER(MATCH(RC[-2],C[-3], 0))"
Range("E2").FormulaR1C1 = "=ISNUMBER(MATCH(RC[-2],C[-3], 0))"
'Range("E2").Select
'Selection.AutoFill Destination:=Rng2, Type:=xlFillDefault
Range("E2").AutoFill Destination:=Rng2, Type:=xlFillDefault
Rng2.Select

'Range("F2").Select
'ActiveCell.FormulaR1C1 = "=IF(RC[-2]=FALSE, RC[-4], """")"
Range("F2").FormulaR1C1 = "=IF(RC[-2]=FALSE, RC[-4], """")"
'Range("F2").Select
'Selection.AutoFill Destination:=Rng3, Type:=xlFillDefault
Range("F2").AutoFill Destination:=Rng3, Type:=xlFillDefault
Rng3.Select

'Range("G2").Select
'ActiveCell.FormulaR1C1 = "=IF(RC[-2]=FALSE, RC[-4], """")"
Range("G2").FormulaR1C1 = "=IF(RC[-2]=FALSE, RC[-4], """")"
'Range("G2").Select
'Selection.AutoFill Destination:=Rng4, Type:=xlFillDefault
Range("G2").AutoFill Destination:=Rng4, Type:=xlFillDefault
Rng4.Select

ActiveWorkbook.Names.Add Name:="List1Only", RefersToR1C1:= _
"=OFFSET(Sheet1!R2C6, 0, 0, COUNTA(Sheet1!C6), 1)"
ActiveWorkbook.Names.Add Name:="List2Only", RefersToR1C1:= _
"=OFFSET(Sheet1!R2C7, 0, 0, COUNTA(Sheet1!C7), 1)"
ActiveWorkbook.Names.Add Name:="List2Only", RefersToR1C1:= _
"=OFFSET(Sheet1!R2C7, 0, 0, COUNTA(Sheet1!C7), 1)"
'ActiveWindow.ScrollRow = 1
'Range("J2").Select
'ActiveCell.FormulaR1C1 = "=CountA(List1Only) - COUNTIF(List1Only, ""*"")"
Range("J2").FormulaR1C1 = "=CountA(List1Only) - COUNTIF(List1Only, ""*"")"
'Range("J3").Select
'ActiveCell.FormulaR1C1 = "=CountA(List2Only) - COUNTIF(List2Only, ""*"")"
Range("J3").FormulaR1C1 = "=CountA(List2Only) - COUNTIF(List2Only, ""*"")"
'Range("H2").Select
'Selection.FormulaArray = _
"=IF(ROWS(R1C4:R[-1]C[-4])>R2C10,"""",INDEX(List1Only,SMALL(IF(List1Only<>"""",ROW(List1Only)-ROW(R2C6)+1),ROWS(R1C4:R[-1]C[-4]))))"
Range("H2").FormulaArray = _
"=IF(ROWS(R1C4:R[-1]C[-4])>R2C10,"""",INDEX(List1Only,SMALL(IF(List1Only<>"""",ROW(List1Only)-ROW(R2C6)+1),ROWS(R1C4:R[-1]C[-4]))))"
'Selection.AutoFill Destination:=Rng5, Type:=xlFillDefault
Range("H2").AutoFill Destination:=Rng5, Type:=xlFillDefault
Rng5.Select

'Range("I2").Select
'Selection.FormulaArray = _
"=IF(ROWS(R1C5:R[-1]C[-4])>R3C10,"""",INDEX(List2Only,SMALL(IF(List2Only<>"""",ROW(List2Only)-ROW(R2C7)+1),ROWS(R1C5:R[-1]C[-4]))))"
Range("I2").FormulaArray = _
"=IF(ROWS(R1C5:R[-1]C[-4])>R3C10,"""",INDEX(List2Only,SMALL(IF(List2Only<>"""",ROW(List2Only)-ROW(R2C7)+1),ROWS(R1C5:R[-1]C[-4]))))"
'Selection.AutoFill Destination:=Rng6, Type:=xlFillDefault
Range("I2").AutoFill Destination:=Rng6, Type:=xlFillDefault
Rng6.Select

'Range("S2").Select
'ActiveCell.FormulaR1C1 = _
"=IF(ISERROR(IF(RC[-11]=""#NUM!"", """", RC[-11])), """", RC[-11])"
Range("S2").FormulaR1C1 = _
"=IF(ISERROR(IF(RC[-11]=""#NUM!"", """", RC[-11])), """", RC[-11])"
'Range("S2").Select
'Selection.AutoFill Destination:=Rng15, Type:=xlFillDefault
Range("S2").AutoFill Destination:=Rng15, Type:=xlFillDefault
Rng15.Select


'Range("U2").Select
'ActiveCell.FormulaR1C1 = _
"=IF(ISERROR(IF(RC[-12]=""#NUM!"", """", RC[-12])), """", RC[-12])"
Range("U2").FormulaR1C1 = _
"=IF(ISERROR(IF(RC[-12]=""#NUM!"", """", RC[-12])), """", RC[-12])"
'Range("U2").Select
'Selection.AutoFill Destination:=Rng17, Type:=xlFillDefault
Range("U2").AutoFill Destination:=Rng17, Type:=xlFillDefault
Rng17.Select


'Columns("W:AD").Select
'Selection.EntireColumn.Hidden = True
Columns("W:AD").EntireColumn.Hidden = True
Range("B2").Select
'ActiveWindow.ScrollColumn = 2
'ActiveWindow.ScrollColumn = 1
Sheets("Sheet2").Protect Password:="pw", DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("Sheet3").Protect Password:="pw", DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveSheet.Protect Password:="pw", DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub
Click to expand...
 
Upvote 0
If the goal is to compare two lists, here's some code that will do that and may be faster. It prompts the user to select the lists with the mouse and then offers options for comparison.
Code: 
Option Base 1
Sub CompareTwoLists()

'Purpose is to compare two lists and identify differences
'between them. Specifically, identify items in list1 that are
'not in list2 and vice-versa.

Dim rng As Range, rList1 As Range, rList2 As Range, cel As Range
Dim msg As String, unMatched1 As String, unMatched2 As String
Dim ctr1 As Long, ctr2 As Long, i As Long, j As Long, K As Long
Dim aList1(), aList2(), aComList(), comCtr As Long, test As Long
Dim rOutput1 As Range, rOutput2 As Range, rOutputCom As Range
msg = "To compare two lists, first use your mouse to select "
msg = msg & "the first list. Then, hold down the control key "
msg = msg & "and select the second list. Then click OK." & vbCrLf & vbCrLf
msg = msg & "NOTE: THIS COMPARISON IS NOT CASE SENSITIVE."

Application.ScreenUpdating = True   'Need for inputbox
Application.Calculation = xlCalculationManual

On Error Resume Next
Set rng = Application.InputBox(prompt:=msg, Type:=8, Title:="COMPARE TWO LISTS")
If Err.Number <> 0 Then Exit Sub 'Cancel was clicked
On Error GoTo 0
If rng.Areas.Count <> 2 Then
    msg = "You must select two ranges and only two. Try again."
    MsgBox msg
    Exit Sub
End If
Application.ScreenUpdating = False
Set rList1 = rng.Areas(1)
Set rList2 = rng.Areas(2)
'First, compare list1 to list2 and single out items NOT in
'list2.

For Each cel In rList1
    On Error Resume Next
    test = WorksheetFunction.Match(cel.Value, rList2, 0)
    If Err.Number <> 0 Then 'there was no match
        unMatched1 = unMatched1 & "; " & cel.Value
        ctr1 = ctr1 + 1
        ReDim Preserve aList1(ctr1)
        aList1(ctr1) = cel.Value
    Else  'There is a match
        comCtr = comCtr + 1
        ReDim Preserve aComList(comCtr)
        aComList(comCtr) = cel.Value
    End If
Next cel
On Error GoTo 0

If ctr1 > 0 Then
    msg = "There are " & ctr1 & " items in List1 that are not in List2." & vbCrLf & vbCrLf
    MsgBox msg & Right(unMatched1, Len(unMatched1) - 1)
    
    Application.ScreenUpdating = True
    msg = "If you want these items placed in a separate list, select a cell to begin the list." & vbCrLf & vbCrLf
    msg = msg & "Otherwise, click Cancel."
    On Error Resume Next
    Set rOutput1 = Application.InputBox(prompt:=msg, Type:=8, Title:="LIST ITEMS FROM LIST1 THAT HAVE NO MATCH IN LIST2")
    If Err.Number = 0 Then
    Application.ScreenUpdating = False
        For i = 1 To UBound(aList1)
            rOutput1.Offset(i - 1, 0).Value = aList1(i)
        Next i
        With rOutput1.Offset(-1, 0)
            .Value = "Unique to List1"
            .Font = "arial narrow"
            .Font.Size = 10
            .Font.Underline = True
            .Font.Bold = True
        End With
        Range(rOutput1.Offset(-1, 0), rOutput1.Offset(-1, 0).End(xlDown)).Columns.AutoFit
    End If
    Application.ScreenUpdating = True
Else   'ctr1 =0
    msg = "There are no items in List1 that are not in List2."
    MsgBox msg
End If
On Error GoTo 0
'Now compare list2 to list1 and single out items from list2
'that are not in list1.

For Each cel In rList2
    On Error Resume Next
    test = WorksheetFunction.Match(cel.Value, rList1, 0)
    If Err.Number <> 0 Then 'there was no match
        unMatched2 = unMatched2 & "; " & cel.Value
        ctr2 = ctr2 + 1
        ReDim Preserve aList2(ctr2)
        aList2(ctr2) = cel.Value
    End If
Next cel
On Error GoTo 0

If ctr2 > 0 Then
    msg = "There are " & ctr2 & " items in List2 that are not in List1." & vbCrLf & vbCrLf
    MsgBox msg & Right(unMatched2, Len(unMatched2) - 1)
    
    Application.ScreenUpdating = True
    msg = "If you want these items placed in a separate list, select a cell to begin the list." & vbCrLf & vbCrLf
    msg = msg & "Otherwise, click Cancel."
    
    On Error Resume Next
    Set rOutput2 = Application.InputBox(prompt:=msg, Type:=8, Title:="LIST ITEMS FROM LIST2 THAT HAVE NO MATCH IN LIST1")
    If Err.Number = 0 Then
    Application.ScreenUpdating = False
        For j = 1 To UBound(aList2)
            rOutput2.Offset(j - 1, 0).Value = aList2(j)
        Next j
        With rOutput2.Offset(-1, 0)
            .Value = "Unique to List2"
            .Font = "arial narrow"
            .Font.Size = 10
            .Font.Underline = True
            .Font.Bold = True
        End With
        Range(rOutput2.Offset(-1, 0), rOutput2.Offset(-1, 0).End(xlDown)).Columns.AutoFit
    
    End If
Else   'ctr2 =0
    msg = "There are no items in List2 that are not in List1."
    MsgBox msg

End If

'Optionally, list common items if there are a large number
'of unique items between the two lists.
If comCtr > 0 Then
    Application.ScreenUpdating = True
    msg = "There are " & comCtr & " COMMON ITEMS among the two lists." & vbCrLf
    msg = msg & "Select a cell if you want to list them, otherwise click Cancel."
    On Error Resume Next
    Set rOutputCom = Application.InputBox(prompt:=msg, Type:=8, Title:="LIST COMMON ITEMS")
    If Err.Number = 0 Then
    Application.ScreenUpdating = False
        For K = 1 To UBound(aComList)
            rOutputCom.Offset(K - 1, 0).Value = aComList(K)
        Next K
        With rOutputCom.Offset(-1, 0)
            .Value = "Common to Both Lists"
            .Font = "arial narrow"
            .Font.Size = 10
            .Font.Underline = True
            .Font.Bold = True
        End With
        Range(rOutputCom.Offset(-1, 0), rOutputCom.Offset(-1, 0).End(xlDown)).Columns.AutoFit
    
    End If
End If
rng.Cells(1, 1).Select
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

Sean15
  • Question Question
Could you help improve recorded macro
2
Replies
13
Views
444
Sean15
Sean15
Dazzawm
  • Solved
Change Range To Recorded Macro
Replies
3
Views
153
Alex Blakenburg
A
T
  • Question Question
ActiveSheet. Paste error
Replies
1
Views
344
RoryA
RoryA
J
  • Question Question
VBA removing heading in spreadsheet
Replies
3
Views
264
rlv01
R
T
  • Solved
Autofill formula via VBA erroring
Replies
3
Views
355
Alex Blakenburg
A

Forum statistics

Threads
1,223,911
Messages
6,175,333
Members
452,636
Latest member
laura12345

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top