Combining Arrays in VBA - arrays

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!

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

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

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

Related

Trying to use .Find to search for an array

I'm currently trying to use .Find to search for an array of items starting with "K". If there is a match then proceed to filter and delete the item. However, I'm not sure if .Find is able to incorporate the array into its condition. I've considered using For each and If, but the code would be considerably long. Anyone can help or give suggestion for a different method?
Dim ckFOH As Range
Dim Krange As Variant
Krange = Sheets("Master List").Range("G17:G" & Range("G17").End(xlDown).Row)
With Sheets("FOH")
Set ckFOH = .Columns("Q").Find(What:=Krange, LookIn:=xlValues)
If Not ckFOH Is Nothing Then
.Rows("5").AutoFilter Field:=17, Criteria1:="=K*"
.Range("A6:K" & Range("A6").End(xlDown).Row).SpecialCells(xlCellTypeVisible).EntireRow.Delete
End If
End With
Find() method of Range object accepts any data type for its "What" parameter, but if you provide a Range (as per your code) or even a 1D array, it's only its first element being actually searched for
moreover from your description I believe that you want to delete all sheet "FOH" rows that have any of actual "K" values found in "Master List" column Q
so you may want to use AutoFilter() and directly filter column Q on all those values providing an array as Criteria1 parameter and activating its xlFilterValues Operator option
as per following code (further explanations in comments):
Option Explicit
Sub main()
Dim Krange As Variant
With Sheets("Master List") 'reference wanted sheet
Krange = Application.Transpose(.Range("G17", .Range("G17").End(xlDown)).Value) ' store referenced sheet column G values from row 17 down to last consecutive not empty cell - explicitly qualify ALL range references to referenced worksheet
End With
With Sheets("FOH") 'reference wanted sheet
With .Range("Q5", .Cells(.Rows.Count, "Q").End(xlUp)) 'reference its column Q range from row 5 (header) to last not empty row
.AutoFilter field:=1, Criteria1:=Krange, Operator:=xlFilterValues ' filtere referenec range on all 'Krange' array values
If CBool(Application.Subtotal(103, .Cells)) > 1 Then .Resize(.Rows.Count - 1, .Columns.Count).Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete ' if any filtered cells other then header, thene delete their entire rows
End With
.AutoFilterMode = False
End With
End Sub

Filtering 2D Arrays and building second 1D array from it in Excel VBA

I have two columns of dates up to 30k lines. I want to filter for one date in the second column and return all the unique dates from the first column.
I could build this in Access but I don't use Access for anything else so it seems overkill to use that. And partly because I am curious if I can do it in Excel.
I'd prefer not to use a loop because it will be expensive in terms of time to run and I am just learning about arrays and class modules so this is a great example.
There is some background on this already on SOF but it's not detailed enough for me - I'm unfamiliar with Class Modules
Filtering 2D Arrays in Excel VBA
Any help or pointers would be greatly appreciated.
Sub CreateUniqueTradeDatesForAsOfDate_test()
Dim InternalArray As Variant
Dim Rg_Internal As Range
Dim arr As New Collection
Dim myRow As Long
Dim myCol As Long
Set d = CreateObject("Scripting.Dictionary")
'set the range
Set Rg_Internal = Worksheets("Bloomberg").Range("G:H")
'Set the array to the range
InternalArray = Rg_Internal.Value
'Transpose the array
InternalArray = Application.Transpose(InternalArray)
'Create the unique
With CreateObject("scripting.dictionary")
For Each it In InternalArray
d = .Item(it)
Next
d = .Keys ' the array .keys contains all unique keys
End With
'print to the immediate window but all unique values of the array
' not just the unique values from the first column based on
'the criteria from the second column
For Each i In d 'To UBound(10, 1)
Debug.Print i; RowNos
Next i
End Sub

How do I paste a formula into a cell based on a cell values coming from an array?

I'm going to try to simplify this a bit because I don't have any code written for this portion of my macro. My macro takes data and copy pastes it multiple times depending on how many time periods I want. The next step is it takes the values in an array and pastes it in a column next to the data the same amount of times. I'm trying to figure out how to then paste formulas into the next column based on which value in the array is in that cell.
Columns A-Q (data) Column R (pasted values from array, 17 total integers) Column S (paste formulas based on value in column R). Note this data extends down between 150k-250k rows so something efficient is desired if possible. I feel like a loop would take years.
Would this just be a two dimensional array? or some sort of vlookup coded in vba? Just looking for a bump in the right direction here. Thanks.
If I understood you correctly, you have a data array (located in columns A-R), and column R is the only thing the formula in column S is directly dependent on.
This macro should do the trick. Assuming you don't plan to do anything computationally intensive to determine the formula, it will also be very fast. On my computer, these two as they are written written execute in 1-2 seconds on 1 million rows.
The macro assumes you will select the part of the data table you want to process. It is only important it includes your "column R" as the last column. It would be also easy to rewrite it so it always takes column R, and it figures out on its own how many rows they are, in case that's your desired behavior.
The macro:
Sub MyMacro()
Dim DataRange As Excel.Range
Dim InputRange As Excel.Range
Dim OutputRange As Excel.Range
Dim InputData() As Variant
Dim OutputData() As Variant
Dim RowNumber As Long
Dim ColumnNumber As Long
Dim i As Long
Set DataRange = Excel.Selection
RowNumber = DataRange.Rows.Count
ColumnNumber = DataRange.Columns.Count
'this sets the input as the last column in the data range and
'the output range exactly next to your array of inputs,
'regardless of whether it ends on column R, S, or wherever
Set InputRange = DataRange.Columns(ColumnNumber)
Set OutputRange = InputRange.Offset(0, 1)
'this stores the values from the input range into an array,
'and initializes the output array (it will be a 2D array - (Row, Column)
InputData = InputRange.Value
OutputData = OutputRange.Value
'you populate the value array inside VBA and only output to excel once -
'this is MUCH faster than interating through the cells directly
For i = 1 To RowNumber
OutputData(i, 1) = FunctionThatReturnsFormulasFromInputs(InputData(i, 1))
Next i
OutputRange.Formula = OutputData
End Sub
Example function:
Function FunctionThatReturnsFormulasFromInputs(InputValue As Variant) As String
Select Case InputValue
Case 1
FunctionThatReturnsFormulasFromInputs = "aaa"
Case Else
FunctionThatReturnsFormulasFromInputs = "bbb"
End Select
End Function

Excel 2007 VBA Assigning part of a named range to an array

I have a table of monthly sales figures - FreqData1. Each column represents a month and is numbered 1 to 12. The user chooses one of these numbers from a dropdown list.
I have the code to find the column number and I have tried to assign the data in that column to an array so I can use it copy it to a different spreadsheet but with my basic VBA knowledge and despite lots of searching I have been unable to find the code as to how to do this or a different method to carry this out.
Can anyone help please
Sub AnnualFreqMacro()
Dim TPNoInt As Long, BranchNoInt As Long, ColNo As Long
Dim FreqArray()
Worksheets("Freq data").Activate
TPNoInt = Range("B42").Value
BranchNoInt = Range("B41").Value
ColNo = Application.Match(TPNoInt, Range("TPBr1"), 0)
CharaArray = Range("FreqData1").Cells (1, ColNo), Cells(16, ColNo))
End Sub
Many thanks in advance
I think this is your answer: It's how you're using the range.
Delete your CharArray = ... line and replace with:
With Range("FreqData1")
CharaArray = .Range(.Cells(1, ColNo), .Cells(16, ColNo))
End With
The issue is how you're setting the range, Range().Cells(), Cells() isn't the context, you'd want something more like Range(Cells(),Cells()).
Let's say "FreqData1" is the range A10:A20. If you use
With Range("FreqData1")
.Cells(1,1).Select
End With
this will select the top left most cell (row 1, column 1) in the range "FreqData", so cell A10 would be selected.
A final misc. point: Avoid using .Select/.Activate. You can activate a sheet of course so you can follow your macro, but when setting variables to ranges/cell values, etc. it's best to qualify which sheet you are referring to.
Sub AnnualFreqMacro()
Dim TPNoInt As Long, BranchNoInt As Long, ColNo As Long
Dim FreqArray()
Dim freqWS As Worksheet
Set freqWS = Worksheets("Freq data")
' Worksheets("Freq data").Activate ' removed this, since we have a variable for it now.
TPNoInt = freqWS.Range("B42").Value ' see how I added the worksheet that we want to get B42's value from?
BranchNoInt = freqWS.Range("B41").Value
ColNo = Application.Match(TPNoInt, Range("TPBr1"), 0)
With freqWS.Range("FreqData1") ' I'm assuming "FreqData1" is on this worksheet
CharaArray = .Range(.Cells(1, ColNo), .Cells(16, ColNo))
End With
End Sub
I'm not positive if you have to qualify a named range's sheet, since it's a named range, but I added that just to be safe.
Edit2: Hm, oddly enough, if your named range "myRange" is A1:A10, you can still do myRange.Range(myRange.cells(1,1),myRange.cells(1,2)), even though there's no second column in the range, it just expands it. I thought it'd throw an error, but nope. Just to note.

Comparing two Arrays with excel VBA

As for the problem, I need to be able to compare all data in Variant array A to all data in Variant array B. I know I need some kind of double loop (so that every A value is checked against all B values), but I can't figure out how to do it. Here's what I have so far:
Sub Button_Click()
Dim trgtRange As Variant
Dim tempRange As Variant
Set myRange = ThisWorkbook.Sheets(1).Range("L:L")
For Each cell In myRange
If IsEmpty(cell) Then
ActiveCell.Offset(-1, 0).Select
currentRow = ActiveCell.Row
Set trgtRange = Range("L2:L" & currentRow)
Exit For
End If
Next cell
Set tempRange = Range("A1:A" & currentRow - 1)
' Insert a double loop here
End Sub
So, trgtRange is the Variant A and tempRange is Variant B. I know I could have set the Variant B up a little easier, but I already did it that way. After all, code should be polished as last operation anyway.
You might be wondering why Variants A and B are completely the same. Well, that's because I need to compare them so that I can find values that are close to each other, (i.e 10000 and 12000) and I need to incorporate some kind of tolerance for it.
Here is my answer. Why do you need two loops to do this. Some relative addressing handles this issue quite nicely. Set up a spreadsheet like this for an example:
and your code is simply this
Sub Button_Click()
Dim dblTolerance As Double
Dim tmp As Range
'Get source range
Set tmp = ActiveSheet.Range("A2")
'Get tolerance from sheet or change this to an assignment to hard code it
dblTolerance = ActiveSheet.Range("D13")
'use the temporary variable to cycle through the first array
Do Until tmp.Value = ""
'Use absolute function to determine if you are within tolerance and if so put match in the column
'NOTE: Adjust the column offset (set to 4 here) to match whichever column you want result in
If Abs(tmp.Value - tmp.Offset(0, 2).Value) < dblTolerance Then
tmp.Offset(0, 4).Value = "Match"
Else
tmp.Offset(0, 4).Value = "No Match"
End If
'Go to the next row
Set tmp = tmp.Offset(1, 0)
Loop
'Clean up
Set tmp = Nothing
End Sub
The comments in the code explain how it works. This is superior to a double loop because relative referencing is faster, the memory use is more efficient and you only have to make one pass at each row.
If you are required for some reason to use a double loop let me know, but that is inferior performance wise to this methodology. Hope this helps.

Resources