Combining Arrays in VBA

Question

I have a list of customers from last year (in column A) and I have a list of customers from this year (in Column B). I've put the data from these two columns in arrays (using the code below - which is set up as Option Base 1):

    'Define our variables and array types'
    Sub CustomerArray()
       Dim LastArray() As String
       Dim CurrentArray() As String
       Dim BothArray() As String
       Dim LR As Long
       Dim i As Integer

    'Define LastArray which is customers last year'
    LR = Cells(Rows.Count, 1).End(xlUp).Row
    ReDim LastArray(LR - 3)
    With Range("A1")
      For i = 1 To LR - 3
        LastArray(i) = .Offset(i, 0)
      Next i
    End With

    'Define CurrentArray which is customers this year'
    ReDim CurrentArray(LR - 3)
    With Range("B1")
      For i = 1 To LR - 3
        CurrentArray(i) = .Offset(i, 0)
      Next i
    End With


    End Sub

Now I want to compare/combine the Arrays to show a list of customers who appear in both of the two arrays I just defined (last year and this year). I want to create a third array with the customers who appear for both years (and I want to put that in column D of my excel sheet). I'm getting confused on how to write the code which will compare these two arrays (current year and last year). Will I use a conditional If > statement? Each of the arrays have the customers listed alphabetically.

I appreicate any help you might be able to give me.

Thanks!

Answer 1

If you want to compare the two arrays using loops, maybe because you have, for example, picked up all the data into arrays for faster computation rather than interacting with the spreadsheet range object, or you need to compare multiple things from the two arrays to check that the entries match so can't use a .find statement, then this is what you need:

-Two loops, one nested inside the other

-Three counters, one for each array

-One "Exit Loop", "Exit For", "GoTo foundmatch" or similar way of exiting the inner loop

-A "Redim Preserve" of the results array

-An "If" statement

-Finally, one line where you assign the name that appears in both arrays to the results array

This is everything that is needed to write it simply as loops - but doesn't give the fastest or best way to do it (Redim Preserve is not the best..). Constructing it should be easy from this list though: the if statement should either be an x=y type for a general usage, or if x>y if you are really really sure that the list being looped in the inner loop really is sorted alphabetically

Answer 2

You don't need to mess with arrays or loop at all, keep it simple, try something like this:

Sub HTH()

    With Range("A1", Cells(Rows.Count, "A").End(xlUp)).Offset(, 3)
        .Formula = "=IF(COUNTIF(B:B,A1)>0,A1,"""")"
        .Value = .Value
        .SpecialCells(xlCellTypeBlanks).Delete
    End With

End Sub

Answer 3

OK. I got a little carried away here, but this does what your are asking (you may have to tune it up to suit your specific needs. To use this code, simply call the Sub "Match Customers".

Your original code proposed the use of three arrays. Excel VBA provides some mechanisms to do what you seek which are both easier to use, and possibly more efficient.

I went ahead and broke the process out into more discrete chunks of code. While it seems like more code, you will find that each peice might make more sense, and it is much more maintainable. You can also now re-use the individual functions for other operations if needed.

I also pulled your range and column indexes out into locally defined constants. This way, if the various row or column references ever need to change, you only have to change the value in one place.

It is not necessarily the most efficient way to do this, but is most likely less complicated than using the arrays you originally propose.

I have not tested this exhaustively, but it works in the most basic sense. Let me know if you have questions.

Hope that helps . . .

Option Explicit

'Set your Column indexes as constants, and use the constants in your code.
'This will be much more maintainable in the long run:
Private Const LY_CUSTOMER_COLUMN As Integer = 1
Private Const CY_CUSTOMER_COLUMN As Integer = 2
Private Const MATCHED_CUSTOMER_COLUMN As Integer = 4
Private Const OUTPUT_TARGET As String = "D1"
Private Const LAST_ROW_OFFSET As Integer = -3


'A Function which returns the list of customers from last year
'as a Range object:
Function CustomersLastYear() As Range
    Dim LastCell As Range

    'Find the last cell in the column:
    Set LastCell = Cells(Rows.Count, LY_CUSTOMER_COLUMN).End(xlUp)

    'Return the range of cells containing last year's customers:
    Set CustomersLastYear = Range(Cells(1, LY_CUSTOMER_COLUMN), LastCell)

End Function


'A Function which returns the list of customers from this year
'as a Range object:
Function CustomersThisYear() As Range
    Dim LastCell As Range

    'Find the last cell in the column:
    Set LastCell = Cells(Rows.Count, CY_CUSTOMER_COLUMN).End(xlUp)

    'Return the range of cells containing this year's customers:
    Set CustomersThisYear = Range(Cells(1, CY_CUSTOMER_COLUMN), LastCell)

End Function


'A function which returns a range object representing the
'current list of matched customers (Mostly so you can clear it
'before re-populating it with a new set of matches):
Function CurrentMatchedCustomersRange() As Range
    Dim LastCell As Range

    'Find the last cell in the column:
    Set LastCell = Cells(Rows.Count, MATCHED_CUSTOMER_COLUMN).End(xlUp)

    'Return the range of cells containing currently matched customers:
    Set CurrentMatchedCustomersRange = Range(Cells(1, MATCHED_CUSTOMER_COLUMN), LastCell)

End Function


'A Function which performs a comparison between two ranges
'and returns a Collection containing the matching cells:
Function MatchedCustomers(ByVal LastYearCustomers As Range, ByVal ThisYearCustomers As Range) As Collection
    Dim output As Collection

    'A variable to iterate over a collection of cell ranges:
    Dim CustomerCell As Range

    'Initialize the collection object:
    Set output = New Collection

    'Iterate over the collection of cells containing last year's customers:
    For Each CustomerCell In LastYearCustomers.Cells
        Dim MatchedCustomer As Range

        'Set the variable to reference the current cell object:
        Set MatchedCustomer = ThisYearCustomers.Find(CustomerCell.Text)

        'Test for a Match:
        If Not MatchedCustomer Is Nothing Then

            'If found, add to the output collection:
            output.Add MatchedCustomer
        End If

        'Kill the iterator variable for the next iteration:
        Set MatchedCustomer = Nothing
    Next

    'Return a collection of the matches found:
    Set MatchedCustomers = output

End Function


Sub MatchCustomers()
    Dim LastYearCustomers As Range
    Dim ThisYearCustomers As Range
    Dim MatchedCustomers As Collection
    Dim MatchedCustomer As Range

    'Clear out the destination column using the local function:
    Set MatchedCustomer = Me.CurrentMatchedCustomersRange
    MatchedCustomer.Clear
    Set MatchedCustomer = Nothing

    'Use local functions to retrieve ranges:
    Set LastYearCustomers = Me.CustomersLastYear
    Set ThisYearCustomers = Me.CustomersThisYear

    'Use local function to preform the matching operation and return a collection
    'of cell ranges representing matched customers. Pass the ranges of last year and this year
    'customers in as Arguments:
    Set MatchedCustomers = Me.MatchedCustomers(LastYearCustomers, ThisYearCustomers)


    Dim Destination As Range

    'Use the local constant to set the initial output target cell:
    Set Destination = Range(OUTPUT_TARGET)

    'Itereate over the collection and paste the matches into the output cell:
    For Each MatchedCustomer In MatchedCustomers
        MatchedCustomer.Copy Destination

        'Increment the output row index after each paste operation:
        Set Destination = Destination.Offset(1)
    Next

End Sub