I have an Excel Worksheet consisting of two columns, one of which is filled with strings and the other is emtpy. I would like to use VBA to assign the value of the cells in the empty column based on the value of the adjacent string in the other column.
I have the following code:
Dim regexAdmin As Object
Set regexAdmin = CreateObject("VBScript.RegExp")
regexAdmin.IgnoreCase = True
regexAdmin.Pattern = "Admin"
Dim i As Integer
For i = 1 To 10 'let's say there is 10 rows
Dim j As Integer
For j = 1 To 2
If regexAdmin.test(Cells(i, j).Value) Then
Cells(i, j + 1).Value = "Exploitation"
End If
Next j
Next i
The problem is that when using this loop for a big amount of data, it takes way too long to work and, most of the time, it simply crashes Excel.
Anyone knows a better way to this?
You have an unnecessary loop, where you test the just completed column (j) too. Dropping that should improve the speed by 10-50%
Dim regexAdmin As Object
Set regexAdmin = CreateObject("VBScript.RegExp")
regexAdmin.IgnoreCase = True
regexAdmin.Pattern = "Admin"
Dim i As Integer
For i = 1 To 10 'let's say there is 10 rows
If regexAdmin.test(Cells(i, 1).Value) Then
Cells(i, 1).offset(0,1).Value = "Exploitation"
End If
Next i
If the regex pattern really is simply "Admin", then you could also just use a worksheet formula for this, instead of writing a macro. The formula, which you'd place next to the text column (assuming your string/num col is A) would be:
=IF(NOT(ISERR(FIND("Admin",A1))),"Exploitation","")
In general, if it can be done with a formula, then you'd be better off doing it so. it's easier to maintain.
Try this:
Public Sub ProcessUsers()
Dim regexAdmin As Object
Set regexAdmin = CreateObject("VBScript.RegExp")
regexAdmin.IgnoreCase = True
regexAdmin.Pattern = "Admin"
Dim r As Range, N As Integer, i As Integer
Set r = Range("A1") '1st row is headers
N = CountRows(r) - 1 'Count data rows
Dim inputs() As Variant, outputs() As Variant
inputs = r.Offset(1, 0).Resize(N, 1) ' Get all rows and 1 columns
ReDim outputs(1 To N, 1 To 1)
For i = 1 To N
If regexAdmin.test(inputs(i, 1)) Then
outputs(i, 1) = "Exploitation"
End If
Next i
'Output values
r.Offset(1, 1).Resize(N, 1).Value = outputs
End Sub
Public Function CountRows(ByRef r As Range) As Long
If IsEmpty(r) Then
CountRows = 0
ElseIf IsEmpty(r.Offset(1, 0)) Then
CountRows = 1
Else
CountRows = r.Worksheet.Range(r, r.End(xlDown)).Rows.Count
End If
End Function
Related
I am a VBA beginner, who cannot seem to find a solution to what seemed to be a very easy comparison to me at first.
Basically, I have 2 columns where the values in the cells are split by a delimiter, however, not in the same order.
eg.
Range("A1").value = "1234|5678"
Range("B1").value = "5678|1234"
B1 should then be highlighted as a duplicate
I am searching for some vba code which I can use to loop through the used range's in Columns A & B, to compare and highlight cells in column B that are duplicated, as per example above.
Apologies if I missed any similar questions asked and answered previously, I have indeed conducted a search but perhaps my search criteria may have been out of bounds, and I simply did not come across the VBA solution.
Regards,
Enjay
Based on the little information given you could try the following code
Sub Highlight()
Const DELIMITER = "|"
Dim rg As Range
Dim a As Variant
Dim b As Variant
Dim sngCell As Range
Set rg = Range("A1:A3")
For Each sngCell In rg
a = Split(sngCell.Value2, DELIMITER)
b = Split(sngCell.Offset(, 1).Value2, DELIMITER)
If isEqual(a, b) Then
With sngCell.Offset(, 1).Interior
.ThemeColor = xlThemeColorAccent6
End With
End If
Next sngCell
End Sub
with the following functions
Function isEqual(a As Variant, b As Variant) As Boolean
a = BubbleSort(a)
b = BubbleSort(b)
isEqual = True
Dim i As Long
For i = LBound(a) To UBound(a)
If a(i) <> b(i) Then
isEqual = False
Exit For
End If
Next i
End Function
Function BubbleSort(ByRef strArray As Variant) As Variant
'sortieren von String Array
'eindimensionale Array
'Bubble-Sortier-Verfahren
Dim z As Long
Dim i As Long
Dim strWert As Variant
For z = UBound(strArray) - 1 To LBound(strArray) Step -1
For i = LBound(strArray) To z
If LCase(strArray(i)) > LCase(strArray(i + 1)) Then
strWert = strArray(i)
strArray(i) = strArray(i + 1)
strArray(i + 1) = strWert
End If
Next i
Next z
BubbleSort = strArray
End Function
This will answer your question as-is. If the solution needs to be adjusted, I trust that you can fix it :)
This uses StrComp to (in memory only) re-order the two string parts so that it can easily detect duplicate values.
Option Explicit
Sub DuplicateCheck()
Dim delimiter As String
delimiter = "|"
Dim lastCol As Long
lastCol = Cells(1, Columns.count).End(xlToLeft).Column
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
Dim i As Long
For i = 1 To lastCol
Dim theSplit As Variant
theSplit = Split(Cells(1, i), delimiter)
Dim temp As String
If StrComp(theSplit(0), theSplit(1), vbTextCompare) = 1 Then
temp = theSplit(1)
theSplit(1) = theSplit(0)
theSplit(0) = temp
End If
temp = theSplit(0) & delimiter & theSplit(1)
If Not dict.exists(temp) Then
dict.Add (temp), 1
Else
Cells(1, i).Interior.color = 65535
End If
Next i
End Sub
Dear stackoverflow community
At work I have to write a macro which should be able to hide rows based on numbers in a column. Those can be multiple ones in one cell and the input should also allow to show more than one number at a time.
for example:
row 1: 20, 30, 15
row 2: 20
row 3: 13, 76
So if I enter 20, 30, it should only show rows 1 & 2)
I usually code with Java / c# and Im new to VBA, so Id really appreciate help:
My plan was to show a input box and split those numbers into an array.
Then i wanna go through each row with a for-Loop, in which i added two for each loops to check if any numbers equal. If not, hide row. If so, show and then i want to exit both for each loops and go to the next row. To exit nested loops, i tried using a do while boolean but it doesnt seem to work.
Right now it only shows the rows with all the input numbers (only row1 in example).
Sub SortingTest()
Dim numbers() As String
myNum = Application.InputBox("Enter BKPS (separate multiples by , )")
numbers = Split(myNum, ",", -1, compare)
'Userinput Vars
Dim row As Integer
row = 1
Dim saveNumber As String
'Looping Vars
Dim existingNum As String
Dim existingNumsArray() As String
Dim checkRows As Long
Dim saveElement As String
Dim done As Boolean
done = False
' Range("B3").Value = 10
' Saves the Input as Array:
For Each Element In numbers
saveNumber = Element
Cells(2, row).Value = saveNumber
row = row + 1
Next Element
Dim b As Integer
Do While done = False
For b = 1 To 100 'hardcoded, should be length of document. b == row;
existingNum = Cells(b, 3).Value
existingNumsArray = Split(existingNum, ",", -1, compare)
' loop thru input numbers
For Each Element In numbers
saveElement = Element
'loop thru given numbers
For Each inputElement In existingNumsArray
If saveElement <> inputElement Then
Rows(b).Hidden = True
ElseIf saveElement = inputElement Then
Rows(b).Hidden = False
done = True
Exit For
End If
Next
Next
Next
Loop
End Sub
Thank you very much for you answer. Yours hid all the rows, so i adjusted it to show them.
Option Explicit
Function ArrOr(a As Variant, b As Variant) As Boolean
Dim runner As Variant
ArrOr = True
If IsArray(a) Then
For Each runner In a
If ArrOr(runner, b) Then Exit Function
Next
Else
For Each runner In b
If Trim(a) = Trim(runner) Then Exit Function
Next
End If
ArrOr = False
End Function
Sub SortingBKPS()
Dim numbers As Variant, vars As Variant, i As Long, xRows As Range
numbers = Split(Application.InputBox("Enter BKPS (separate multiples by , )"), ",")
With Sheets("Sheet1")
vars = .Range("B1", .Cells(.Rows.Count, 2).End(xlUp)).Value2
For i = 2 To UBound(vars)
.Rows(i).EntireRow.Hidden = True
If ArrOr(Split(vars(i, 1), ","), numbers) Then
If xRows Is Nothing Then
Set xRows = .Rows(i)
Else
Set xRows = Union(xRows, .Rows(i))
End If
End If
Next
xRows.EntireRow.Hidden = False
End With
End Sub
By splitting it up it is very easy to do:
Option Explicit
Function ArrOr(a As Variant, b As Variant) As Boolean
Dim runner As Variant
ArrOr = True
If IsArray(a) Then
For Each runner In a
If ArrOr(runner, b) Then Exit Function
Next
Else
For Each runner In b
If Trim(a) = Trim(runner) Then Exit Function
Next
End If
ArrOr = False
End Function
Sub SortingTest()
Dim numbers As Variant, vars As Variant, i As Long, xRows As Range
numbers = Split(Application.InputBox("Enter BKPS (separate multiples by , )"), ",")
With Sheets("Sheet1")
vars = .Range("B1", .Cells(.Rows.Count, 2).End(xlUp)).Value2
For i = 1 To UBound(vars)
If ArrOr(Split(vars(i, 1), ","), numbers) Then
If xRows Is Nothing Then
Set xRows = .Rows(i)
Else
Set xRows = Union(xRows, .Rows(i))
End If
End If
Next
xRows.EntireRow.Hidden = True
End With
End Sub
by running this code line by line, it should be pretty much self explaining (also knowing you have already some knowledge in "coding")
Still, if you have any questions, just ask ;)
You can also do it the following way:
Sub SortingTest()
Dim numbers As Variant
Dim RangeCompare As Range
Dim MyRow As Integer
Dim NumFound As Boolean
numbers = Application.InputBox("Please,list the values in this format: " & _
vbCrLf & "{value, value, value, ...}", _
Default:="{#, #, #}", Type:=64)
For MyRow = 1 To Cells(Rows.Count, 1).End(xlUp).row
Set RangeCompare = Range(Cells(MyRow, 1), Cells(MyRow, Columns.Count).End(xlToLeft))
NumFound = False
For Each rCell In RangeCompare
For Each Element In numbers
If rCell = Element Then
NumFound = True
Exit For
End If
Next Element
If NumFound = True Then Exit For
Next rCell
If NumFound = False Then
Rows(MyRow).Hidden = True
End If
Next MyRow
End Sub
I think it's easy to understand but feel free to ask for explanation.
Say, my original data block is worksheets(1).range("A1:C100"), and I'd like to stack the columns of this block into a single column, that is, I first put first column, then the second column goes below, and finally the third column. In the end, I should have a single column, say being put in worksheets(2).range("A1:A300"). I wonder if there's any smart and fast algorithm to achieve this?
Without VBA, In Sheet2 cell A1 enter:
=OFFSET(Sheet1!$A$1,MOD(ROWS($1:1)-1,100),ROUNDUP(ROWS($1:1)/100,0)-1,)
and copy down.
and with VBA
Sub copy_table_to_column()
Dim s As String
s = "=OFFSET(Sheet1!$A$1,MOD(ROWS($1:1)-1,100),ROUNDUP(ROWS($1:1)/100,0)-1,)"
With Worksheets("Sheet2").Range("A1:A300")
.Formula = s
.Value = .Value
End With
End Sub
There might be a better way, but I usually do it with an Offset
I=0
For Each A in Worksheets(1).Range("A1:A100").Cells
Worksheets(2).Range("A1").Offset(I,0) = A.Value
I = I + 1
Next
For Each B in Worksheets(1).Range("B1:B100").Cells
Worksheets(2).Range("A1").Offset(I,0) = B.Value
I = I + 1
Next
For Each C in Worksheets(1).Range("C1:C100").Cells
Worksheets(2).Range("A1").Offset(I,0) = C.Value
I = I + 1
Next
This might be good enough for you...
Hope it helps.
Option Explicit
'Define the test function...
Sub test()
Dim vData As Variant
Dim r As Range
Set r = Sheet1.Range("A1:C100")
vData = ConcatinateColumns(r)
End Sub
'Define the function to concatinate columns.
Public Function ConcatinateColumns(ByVal Data As Range)
Dim vTemp As Variant
Dim i As Integer, j As Long, k As Long
'Get the data for each cell to a variant.
vTemp = Data.Value
ReDim vData(1 To (UBound(vTemp, 1) - LBound(vTemp, 1) + 1) * (UBound(vTemp, 2) - LBound(vTemp, 2) + 1), 1 To 1) As Variant
For i = LBound(vTemp, 2) To UBound(vTemp, 2)
For j = LBound(vTemp, 1) To UBound(vTemp, 1)
k = k + 1
vData(k, LBound(vData, 1)) = vTemp(j, i)
Next
Next
ConcatinateColumns = vData
End Function
Excel File Format
I have master data table with attribute ID which is unique and unit.
I have another table where I add the product values associated with the attributes.
If the units match based on the attribute ID, then the cells are highlighted in green else red.
To achieve the above, I have written some basic code, but it doesn't seem to work. The vlookup works normally but using vba it just exits. Please see image for example and code below. Column a and b contains attribute master data and column d to g contain product attribute values.
Eg. For product p1, value 'IN' is valid for attribute 'A1' but 'm' is not valid.
Also, there can be multiple units separated by comma for each attribute. Need help to solve issue.
Code:
Sub UnitCheck()
Dim AttrIDrange As range, AttrIDcell As range
Dim attrID
Dim Lookup_Range As range
Dim I, J As Variant
Dim UNIT As Variant
Set Lookup_Range = range("A2:B4")
Set AttrIDrange = range("E1:G1")
For Each AttrIDcell In AttrIDrange
attrID = AttrIDcell.Value
For I = 2 To 3
For J = 5 To 7
If Application.WorksheetFunction.VLookup(attrID, Lookup_Range, 2, False) = UNIT Then
Worksheets("Sheet4").Cells(I, J).Font.Color = vbGreen
Else
Worksheets("Sheet4").Cells(I, J).Font.Color = vbRed
End If
Next
Next
Next
End Sub
New Scenario:
If there are multiple units defined for any attribute, then even if only 1 of the unit is present in the product value, it should be highlighed in green. If 1 is correct and rest are incorrect then since it is partially correct, it should be highlighted in red or even yellow. Please see image. Need help for this scenario.
Scenario 2 Image
When cycling through the I and J loops, you need to set UNIT to something before you can compare it to the results passed back from the worksheet VLOOKUP function.
Sub UnitCheck()
Dim AttrIDrange As Range, AttrIDcell As Range
Dim attrID
Dim Lookup_Range As Range
Dim I As Long, J As Long
Dim UNIT As Variant
Dim bCHECK_P1
With Worksheets("Sheet4")
bCHECK_P1 = False
Set Lookup_Range = .Range("A2:B4")
Set AttrIDrange = .Range("E1:G1")
For Each AttrIDcell In AttrIDrange '.Range("E1:G1")
attrID = AttrIDcell.Value
For I = 2 To 3
UNIT = AttrIDcell.Offset(I - 1, 0).Value '<~~ set UNIT here!
For J = 5 To 7
.Cells(I, J).Font.Color = xlAutomatic
If Application.WorksheetFunction.VLookup(attrID, Lookup_Range, 2, False) = UNIT Then
.Cells(I, J).Font.Color = vbGreen
Else
.Cells(I, J).Font.Color = vbRed
End If
Next
Next
Next
End With
End Sub
Here's something that I think does what the OP is asking. Also, this replaces the triple For/next and VLookUp with a dictionary which is hopefully more amenable.
In regard to the OP, I see two fundamental problems, UNIT is never assigned, but also, it sounds like the = operator isn't correct... instead, it sounds like a lookup value must be confirmed present in a comma separated string. The code below uses InStr to check if the lookup value is present.
Sub UnitCheck()
Application.ScreenUpdating = False
Dim UNIT As String
Dim R, c, AttrID As Integer
Dim ProdRange, ProdCell As Range
Set ProdRange = Range("E2:G4")
'Assign LookUp values to array
Dim LookUpArray(), ProdAttrIDArray() As Variant
LookUpArray = Range("A2:B4").Value2
'Create dictionary from Lookup values
Set D = CreateObject("Scripting.Dictionary")
For R = 1 To UBound(LookUpArray)
D.Add LookUpArray(R, 1), LookUpArray(R, 2)
Next
'Loop through product table
For Each ProdCell In ProdRange
'Get attribute ID from row 1 of corresponding column
AttrID = Cells(1, ProdCell.Column).Value2
If D(AttrID) <> Empty Then
'If AttrID found in LookUp Dictionary then get UNIT from it
UNIT = D(AttrID)
'If UNIT found in product cell then color cell green, else red
If (InStr(1, ProdCell.Value2, UNIT) > 0) Then
ProdCell.Interior.Color = vbGreen
Else
ProdCell.Interior.Color = vbRed
End If
End If
Next
End Sub
The result is this
New Scenario
Ok, I think this will cover your new scenario. Notice that I also added Trim() and VBTextCompare so that spaces are ignored and the comparison is case-insensitive. I'm not sure if you want that behavior or not. Also, notice that the order of units does not matter. For example, "IN, km" matches "KM, IN" because the spaces are ignored, capitalization is ignored, and the order is ignored.
Sub UnitCheck()
Application.ScreenUpdating = False
Dim UNIT, PUnits() As String
Dim r, c, AttrID, i, n As Integer
Dim ProdRange, ProdCell As Range
Set ProdRange = Range("E2:G3")
'Assign LookUp values to array
Dim LookUpArray(), ProdAttrIDArray() As Variant
LookUpArray = Range("A2:B4").Value2
'Create dictionary from Lookup values
Set D = CreateObject("Scripting.Dictionary")
For r = 1 To UBound(LookUpArray)
D.Add LookUpArray(r, 1), LookUpArray(r, 2)
Next
'Loop through product table
For Each ProdCell In ProdRange
'Get attribute ID from row 1 of correspdniong column
AttrID = Cells(1, ProdCell.Column).Value2
If D(AttrID) <> Empty Then
'If AttrID found in LoopUp Dictionary then get UNIT from it
UNIT = D(AttrID)
PUnits = Split(ProdCell.Value2, ",")
'reset counter
n = 0
'Count the number of product units found in the lookup value
For i = 0 To UBound(PUnits)
If InStr(1, Trim(UNIT), Trim(PUnits(i)), vbTextCompare) > 0 Then
n = n + 1
End If
Next
'prevent division by zero
If i = 0 Then i = 1
'select action based on percent matched
Select Case n / i
Case Is >= 1
ProdCell.Interior.Color = vbGreen
Case Is > 0
ProdCell.Interior.Color = vbYellow
Case Else
ProdCell.Interior.Color = vbRed
End Select
End If
Next
End Sub
This the code I am trying to run:
Option Explicit
Sub Test()
'-------------Declarations-------------------
Dim FinalRow, Sum As Long
Dim i, j, l, d, k, count As Integer
Dim custID(), amtPur() As Long
Dim ws As Worksheet
Set ws = Sheets("Data")
FinalRow = ws.Range("B90000").End(xlUp).Row
j = 0
'-------------Get All the Data-------------------
With ws
For i = 4 To FinalRow
custID(j) = ws.Range("B" & i).Value 'Error Here
amtPur(j) = ws.Range("C" & i).Value 'Error Here
j = j + 1
Next i
End With
'-------------Match it and present the output----
l = 4
Dim wk As Worksheet
Set wk = Sheets("Results")
With wk
For j = 0 To FinalRow
Sum = amtPur(j)
'For the first iteration
If j = 0 Then
For k = j + 1 To FinalRow
If custID(j) = custID(k) Then
Sum = amtPur(k) + Sum
Else: End If
Next k
wk.Range("A" & 3).Value = custID(j).Value
wk.Range("B" & 3).Value = Sum
Else: End If
'For the rest iterations
count = 0
d = j
Do While (d >= 0)
If custID(d) = custID(j) Then
count = count + 1
Else: End If
d = d - 1
Loop
If count <= 1 Then 'Check if instance was already found
For k = j + 1 To FinalRow
If custID(j) = custID(k) Then
Sum = amtPur(k) + Sum
Else: End If
Next k
wk.Range("A" & l).Value = custID(j).Text
wk.Range("B" & l).Value = Sum
l = l + 1
End If
Next j
End With
End Sub
but unfortunately am getting:
Subscript out of Range - Run time error 9
when I try to run it.
While you have declared your custID() and amtPur() arrays, they need to be initialised using ReDim statements before you can use them. In your case you will want to ReDim Preserve to retain values already stored in the arrays during prior loops:
Sub Test()
'-------------Declarations-------------------
Dim FinalRow, Sum As Long
Dim i As Integer
j As Integer
l As Integer
d As Integer
k As Integer
count As Integer
Dim custID() As Long, amtPur() As Long
Dim ws As Worksheet
Set ws = Sheets("Data")
FinalRow = ws.Range("B90000").End(xlUp).Row
j = 0
'-------------Get All the Data-------------------
With ws
For i = 4 To 100
ReDim Preserve custID(0 To j)
ReDim Preserve amtPur(0 To j)
custID(j) = ws.Range("B" & i).Value 'Error Here
amtPur(j) = ws.Range("C" & i).Value 'Error Here
j = j + 1
Next i
End With
End Sub
Hmm, seems a little harsh that this question has been downvoted. You're clearly new to VBA and it does seem that you've given this a fair go. I admire people who learn through trial and error - it's certainly more than many first posters do - so I'd like to give you a pretty full answer with a bit of the theory behind it:
Dim - as mentioned, declare each type. Avoid names that are similar to existing functions, like sum.
If you declare your 'read' variable as a variant, you can read the data from the worksheet with just one line and the array will be dimensioned for you. You can also acquire custID and amtPur in the same array. I've given you an example of this in the code below in a variable called custData. Be aware that these arrays have a base of 1 rather than 0.
Your With blocks are redundant. These are meant to save you repeating the object each time you access its properties. In your code you repeat the object. I'm not a huge fan of With blocks but I've put a sample in your code so you can see how it works.
Your If ... Else ... End If blocks are a bit muddled. The logic should be If (case is true) Then do some code Else case is false, so do some other code End If. Again, I've tried to re-write your code to give you examples of this.
You are confusing looping through a Range and looping through an Array. In your code you have set the limits of the Range as 4 - FinalRow. However, this does not mean your arrays have been set to the same dimensions. Most likely, your arrays start from 0 and go to FinalRow - 4. You need to be clear about these dimensions before looping.
As Mark Fitzgerald mentions, you need to dimension your array before using it. If it's an initial dimension then you could just use Redim. If you want to increase the array's dimension whilst retaining existing values then use Redim Preserve. I've tried to give you an example of both in the code below.
Okay, so onto your code...
With the looping, array size and If mistakes, it's rather difficult to see what you're trying to do. I think you might be trying to read all the customer IDs, writing them into a unique list and then summing all the values that match each ID. The code below does that. It's not the quickest or best way, but I've tried to write the code so that you can see how each of the errors above should work. I guess it doesn't matter if I'm up the wrong path as the main aim is to give you an idea of how to manage arrays, loops and Ifs. I hope your custID and amtPur are genuinely Longs - if, for example, amtPur stands for 'amount purchased' and is, in fact, a decimal number then this code will throw and error, so make sure your values and declarations are of the same type. Your commenting etiquette is a little esoteric but I've still followed it.
Good luck with your project and keep at it. I hope this helps you:
'-------------Declarations-------------------
Dim dataSht As Worksheet
Dim resultsSht As Worksheet
Dim custData As Variant
Dim uniqueIDs() As Long
Dim summaryData() As Long
Dim counter As Integer
Dim isUnique As Boolean
Dim rng As Range
Dim i As Integer
Dim j As Integer
'-------------Get All the Data-------------------
Set dataSht = ThisWorkbook.Sheets("Data")
Set resultsSht = ThisWorkbook.Sheets("Results")
With dataSht
Set rng = .Range(.Cells(4, "B"), .Cells(.Rows.Count, "B").End(xlUp)).Resize(, 2)
End With
custData = rng.Value2 'writes worksheet to variant array
'-------------Loop through the data to find number of unique IDs----
For i = 1 To UBound(custData, 1)
isUnique = True
If i = 1 Then
'First iteration so set the counter
counter = 0
Else
'Subsequent iterations so check for duplicate ID
For j = 1 To counter
If uniqueIDs(j) = custData(i, 1) Then
isUnique = False
Exit For
End If
Next
End If
'Add the unique ID to our list
If isUnique Then
counter = counter + 1
ReDim Preserve uniqueIDs(1 To counter)
uniqueIDs(counter) = custData(i, 1)
End If
Next
'-------------Aggregate the amtPur values----
ReDim summaryData(1 To counter, 1 To 2)
For i = 1 To counter
summaryData(i, 1) = uniqueIDs(i)
'Loop through the data to sum the values for the customer ID
For j = 1 To UBound(custData, 1)
If custData(j, 1) = uniqueIDs(i) Then
summaryData(i, 2) = summaryData(i, 2) + custData(j, 2)
End If
Next
Next
'-----------Outpute the results to the worksheet----
Set rng = resultsSht.Cells(4, 1).Resize(counter, 2)
rng.Value = summaryData