Matching two data lists in Excel VBA and exporting to New Sheet

Question

I receive an excel file monthly and have to export parts of it to a new file. I have a list of identifier numbers and I am trying to match the list of numbers in the selected list to the full file and then export the rows of relevant data to a new sheet.

Sub Run_All_Macros()
Application.ScreenUpdating = False
Sheets.Add.Name = "Output"
Call Convert_to_Numbers
Call Highlight_Selected_Contractors
End Sub

'Original Spreadsheet is formatted incorrectly
'Convert PSD Codes to Numbers
Sub Convert_to_Numbers()
Dim xCell As Range
Range("A2:A2500").Select
    For Each xCell In Selection
    xCell.Value = CDec(xCell.Value)
    Next xCell
End Sub


'Highlight Selected Contractors
Sub Highlight_Selected_Contractors()
Dim Full, Selection, Code, SelectedCode As Range
Worksheets("Sheet1").Select
'Set all cells in Column A Sheet 1 to Full
Set Full = Worksheets("Sheet1").Range("A1", Range("A1").End(xlDown))
'Set all cells in Column A Sheet 2 to Selection
Worksheets("Sheet2").Select
Set Selection = Worksheets("Sheet2").Range("A1", Range("A1").End(xlDown))
'If the numbers match highlight the cell
For Each Code In Full
    For Each SelectedCode In Selection
        If Code.Value = SelectedCode.Value Then
       *** Code.Select
        Selection.Copy
        Sheets.Select ("Output")
        ActiveSheet.Paste
    End If
Next SelectedCode
Next Code
End Sub

After executing this code column A in 'Output' is filled with zeros from A2:A2500. From messing around with breakpoints I've identified the problem to be where I've placed * but I'm not sure what's wrong with what's written there.

Thanks

Answer 1

There few errors in the code above and I also have few suggestions and finally the code.

ERRORS

1) Sheets.Add.Name = "Output" This line will give you an error if there is already a sheet called "Ouput". Delete the sheet first and then create it. You must be wondering that in case the sheet is not there, then how can I delete it? For such scenarios you can use On Error Resume Next which should be avoided in most cases.

2) When working with ranges, always specify which sheet you are referring to else Excel will always assume that you are referring to the "ActiveSheet". As you realized that Sub Convert_to_Numbers() was taking Output Sheet into consideration whereas you want the operation to happen in "Output" Sheet.

3) Dim Full, Selection, Code, SelectedCode As Range As mentioned in my comments earlier avoid using Excel Reserved words as variables. Also unlike VB.Net, if you declare variables as you did in VBA then only the last variable will be declared as Range. The other 3 will be declared as variant. VB defaults the variable to being type Variant. A Variant type variable can hold any kind of data from strings, to integers, to long integers, to dates, to currency etc. By default “Variants” are the “slowest” type of variables. Variants should also be avoided as they are responsible for causing possible “Type Mismatch Errors”. It’s not that we should never use Variants. They should only be used if you are unsure what they might hold on code execution.

4) Avoid the use of words like .ActiveCell, Selection, Select, Activate etc. They are a major cause of errors. Also they slow your code down.

SUGGESTIONS

1) Instead to using Sheets("WhatEver") every time, store it in a variable and then use that variable. Will cut down your code.

2) Indent your code :) it's much easier to read

3) Group tasks together. For example if you have to do with something with a particular sheet then keep it together. It is easier to read and amend if required.

4) Instead of hard coding your values, get actual ranges. Range("A2:A2500") is a classic example. Will you always have data till 2500? What if it is less or more?

5) End(xlDown) will never give you the last row if there is a blank cell in between. To get the last row in a column, say A in "Sheet1", use this

Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row`

6) Instead of looping, you can use the WorksheetFunction CountIf(). Loops should be avoided as much as possible as they slow down your code.

7) Use appropriate Error handling.

8) Comment your code. It's much easier to know what a particular code or section is doing.

CODE

Option Explicit

Sub Run_All_Macros()
    Dim ws1I As Worksheet, ws2I As Worksheet, wsO As Worksheet
    Dim ws1LRow As Long, ws2LRow As Long, wsOLr As Long
    Dim xCell As Range, rFull As Range, rSelection As Range
    Dim rCode As Range, rSelectedCode As Range

    On Error GoTo Whoa '<~~ Error Handling

    Application.ScreenUpdating = False

    '~~> Creating the Output Sheet
    Application.DisplayAlerts = False
    On Error Resume Next
    Sheets("Output").Delete
    On Error GoTo 0
    Sheets.Add.Name = "Output"
    Application.DisplayAlerts = True

    '~~> Working with 1st Input Sheet
    Set ws1I = Sheets("Sheet1")
    With ws1I
        '~~> Get Last Row of Col A
        ws1LRow = .Range("A" & Rows.Count).End(xlUp).Row
        '~~> Set the range we want to work with
        Set rFull = .Range("A1:A" & ws1LRow)
        '~~> The following is not required unless you want to just format the sheet
        '~~> This will have no impact on the comparision. If you want you can
        '~~> uncomment it
        'For Each xCell In .Range("A2:A" & ws1LRow)
            'xCell.Value = CDec(xCell.Value)
        'Next xCell
    End With

    '~~> Working with 2nd Input Sheet
    Set ws2I = Sheets("Sheet2") '<~~ Input Sheet 2
    ws2LRow = ws2I.Range("A" & Rows.Count).End(xlUp).Row
    Set rSelection = ws2I.Range("A1:A" & ws2LRow)

    '~~> Working with Output Sheet
    Set wsO = Sheets("Output")
    wsO.Range("A1") = "Common values"
    wsOLr = wsO.Range("A" & Rows.Count).End(xlUp).Row + 1

    '~~> Comparison : If the numbers match copy them to Output Sheet
    For Each rCode In rFull
        If Application.WorksheetFunction.CountIf(rSelection, rCode.Value) > 0 Then
            rCode.Copy wsO.Range("A" & wsOLr)
            wsOLr = wsOLr + 1
        End If
    Next rCode

    MsgBox "Done"

LetsContinue:
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume LetsContinue
End Sub

Let me know if you still get any errors :)

HTH