VBA Filing Arrays and creating columns

Question

I need to write a sub that captures the existing lists in two arrays and then create two new arrays of customer names and amounts spent for customers who spent at least $500. After these new arrays have been filled, I have to write them in columns D and E.

So say column 1 is from A3:A50 and this has the customer's names and column 2 is from C3:50 with the sales price that the customer purchase.

I am having trouble writing the part of the code that sorts through the arrays and decides if the sales price is greater than $500. Can someone point me where its going wrong?

This is what I have so far but it does not work:

Sub ProductSales()
' These are inputs: the number of customers, the customer's name,
' and the dollar amount of each sale.
Dim nCustomers As Integer
Dim namesData() As String
Dim dollarsData() As Integer

' The following are outputs: the customer name found over 500, and the number
'of customer over 500
Dim customerFound() As String
Dim customerCount() As Integer

' Variables used in finding if sale is over 500
Dim isOver As Boolean
Dim nFound As Integer

' Counters.
Dim i As Integer
Dim j As Integer

' Clear any old results in columns E to G.
With wsData.Range("E2")
    Range(.Offset(1, 0), .Offset(0, 2).End(xlDown)).ClearContents
End With

' Find number of customers in the data set, redimension the namesdata and
' dollarsData arrays, and fill them with the data in columns A and C.
With wsData.Range("A2")
    nCustomers = Range(.Offset(1, 0), .End(xlDown)).Rows.Count
    ReDim namesData(1 To nCustomers)
    ReDim dollarsData(1 To nCustomers)
    For i = 1 To nCustomers
        namesData(i) = .Offset(i, 0).Value
        dollarsData(i) = .Offset(i, 2).Value
    Next
End With

' Initialize the number of names found to 0.
nFound = 0

' Loop through all sales.
For i = 1 To nCustomers

    ' Set the Boolean isOver to False, and change it to True only
    ' if the sale is over 500
    isOver = False
    If nFound > 0 Then
        ' Loop through all customer names already found and add to new list
        ' and exit loop
        For j = 1 To nFound
            If dollarsData(i) > 500 Then
                isOver = True
                customerCount(j) = customerCount(j) + 1
                Exit For
            End If
        Next
    End If

    If isOver Then
        ' The current product code is a new one, so update the list of
        ' codes found so far, and initialize the transactionsCount and dollarsTotal
        ' values for this new product.
        nFound = nFound + 1
        ReDim Preserve customerFound(1 To nFound)
        ReDim Preserve customerCount(1 To nFound)
        customerCount(nFound) = namesData(i)
        customerCount(nFound) = 1

    End If
Next

' Place the results in columns E to G.
For j = 1 To nFound
    With wsData.Range("E2")
        .Offset(j, 0).Value = customerFound(j)
        .Offset(j, 1).Value = customerCount(j)

    End With
Next

End Sub

Answer 1

Excel VBA has a great capability of writing a Range to an array in one line. It's extremely quick and saves the developer having to write his/her own iteration code as you have done. Array is declared as a Variant and syntax is:

readArray = Range("A3:A50").Value2

The same applies to writing the array to your sheet. Syntax is:

 Range("A3:A50").Value = writeArray

So in this part of your project, you'd simply need to read the two columns. Loop through them to find your target items and then populate your output array. You do need to dimension the output array so in this example I've used a Collection which stores each index of a found item and the sizing is simply Collection.Count.

The sample below hard-codes your range dimension but it should give you an idea of how to simplify your own code:

Dim ws As Worksheet
Dim namesData As Variant
Dim dollarsData As Variant
Dim output() As Variant
Dim foundIndexes As Collection
Dim i As Long
Dim v As Variant

'Set the worksheet object
Set ws = ThisWorkbook.Worksheets("Sheet1") 'change to your sheet name

'Read the data
With ws.Range("A3:A50")
    namesData = .Value2
    dollarsData = .Offset(, 2).Value2
End With

'Find the target customers
Set foundIndexes = New Collection
For i = 1 To UBound(dollarsData, 1)
    If dollarsData(i, 1) > 500 Then
        foundIndexes.Add i
    End If
Next

'Size the output array
ReDim output(1 To foundIndexes.Count, 1 To 2)

'Populate the output array
i = 1
For Each v In foundIndexes
    output(i, 1) = namesData(v, 1)
    output(i, 2) = dollarsData(v, 1)
    i = i + 1
Next

'Write array to sheet
ws.Range("D3").Resize(UBound(output, 1), UBound(output, 2)).Value = output

Answer 2

I'm not quite sure what's your actual goal

but you may start with this

Option Explicit

Sub ProductSales()
Dim nCustomers As Integer ' inputs: the number of customers
Dim namesData As Variant, dollarsData As Variant 'inputs: the customer's name, and the dollar amount of each sale
Dim customerFound As Variant, customerDollarsFound As Variant 'ouputs: the customer name found over 500, and their corresponding dollars
Dim firstValueIndex As Long ' index for the first dollar value > 500 in sorted column, if any

With Worksheets("wsData")

    .Range("E3:G" & .Cells(.Rows.Count, "E").End(xlUp).Row).ClearContents '<~~ clear previous results

    With .Range("A1:A" & .Cells(.Rows.Count, 1).End(xlUp).Row) '<~~ consider column A values down to its last non empty cell
        .Resize(, 3).Sort key1:=.Cells(1, 3), Order1:=xlDescending, Header:=xlYes '<~~ sort it by dollar amount in ascending order
        With .Range("A2:A" & .Cells(.Rows.Count, 1).End(xlUp).Row) '<~~ consider column A form range A2 to down to its last non empty cell, which could be now different since sort has shifted blank cells to the range end
            namesData = Application.Transpose(.Value) '<~~ fill first array
            dollarsData = Application.Transpose(.Offset(, 2).Value) '<~~fill 2nd array
            If GetFirstIndex(.Offset(, 2).Cells, 501, firstValueIndex) Then '<~~ if there's any value > 500 in column "C" (i.e. two columns right of "A") ...
                customerFound = Application.Transpose(.Resize(firstValueIndex).Value) '<~~ ... then fill first output array...
                customerDollarsFound = Application.Transpose(.Resize(firstValueIndex).Offset(, 2).Value) '<~~ ... and second output array
            End If
        End With
    End With

    If firstValueIndex > 0 Then '<~~ if output arrays have values...
        .Range("E3").Resize(firstValueIndex).Value = Application.Transpose(customerFound) '<~~ ... then fill output range for names...
        .Range("F3").Resize(firstValueIndex).Value = Application.Transpose(customerDollarsFound) '<~~ and fill output range for dollars
    End If

End With

End Sub

Function GetFirstIndex(rng As Range, minVal As Double, firstIndex As Long) As Boolean
    On Error Resume Next
    firstIndex = WorksheetFunction.Match(minVal, rng, -1)
    GetFirstIndex = firstIndex > 0
End Function