How would you do this - handling duplicates in arrays in specific ways

[TheRedCardinal]

Looking for help on this problem which has stumped me today!

The basic purpose of my code is:

1. Load the data from a range into an array in VBA
2. Play with that data a bit
3. Put the outputs from that manipulation into 2 new arrays in VBA
4. Output the arrays to 2 different ranges in the original workbook

All this is working fine, but I am having a problem with handling correctly what to do when a duplicate occurs in a specific column. Before loading the original array, the data is sorted by this column so duplicates should be next to each other. (This is not necessary for anything except this duplicate testing process so can easily get rid of the sort).

Here is a picture of typical source data, with the duplicates highlighted:

The check column is column B - entry number.

What I need to happen is:

1. When looping through my array, find out if the entry in position LoopCounter,2 matches the entry in LoopCounter -1,2 - i.e. is it the same as the last line
2. If it is, for Output Array 1, simply add the value of Score 2 cell to the value already existing in the Score 2 for the previous row, i.e. a total score for all lines with that entry number

The output should look like this (i.e. this is what Output Array 1 should create):

Note that the 2 sets of duplicates now occupy 1 line, and the total score 2 has been added up. The other fields all match. (There is more in the real data).
There are 19 line numbers.

But for Output Array 2, I need something slightly different:

1. Each line from the source is shown as an individual line with its own row in the output
2. Each individual element of the duplicated lines is shown by its own
3. But each line of the duplicate shares the same line number as that row in Output Array 1.
4. So there will be 22 rows of data, but only 19 line numbers matching Output Array 1

Here is an example:

I tried the following code:

Sub PopulateArrays()

Set Wbk1 = ThisWorkbook
Set WS1 = Wbk1.Sheets("Source Data")
Set WS2 = Wbk1.Sheets("Output 1")
Set WS3 = Wbk1.Sheets("Output 2")

Dim LoadArray As Variant, Output1 As Variant, Output2 As Variant
Dim Counter As Long, RowNumber As Long

LoadArray = WS1.Range("A2:F23")

ReDim Output1(1 To 23, 1 To 4) As Variant
ReDim Output2(1 To 23, 1 To 3) As Variant

RowNumber = 1
For Counter = 1 To UBound(LoadArray)

If Counter = 1 Then GoTo FullLoad

If LoadArray(Counter, 2) = LoadArray(Counter - 1, 2) Then
    
    Output1(Counter - 1, 4) = Output1(Counter - 1, 4) + LoadArray(Counter, 6)
    Output2(Counter, 2) = LoadArray(Counter, 5)
    Output2(Counter, 3) = LoadArray(Counter, 6)
    Output2(Counter, 1) = Counter - 1
    
    GoTo Skip

End If

FullLoad:
Output1(Counter, 4) = LoadArray(Counter, 6)
Output1(Counter, 1) = Counter
Output1(Counter, 2) = LoadArray(Counter, 3)
Output1(Counter, 3) = LoadArray(Counter, 1)

Output2(Counter, 1) = Counter
Output2(Counter, 2) = LoadArray(Counter, 5)
Output2(Counter, 3) = LoadArray(Counter, 6)

Skip:
Next Counter

WS2.Range("A2").Resize(UBound(Output1), UBound(Output1, 2)) = Output1
WS3.Range("A2").Resize(UBound(Output2), UBound(Output2, 2)) = Output2

End Sub

But the problems I encountered were:

1. It kind of worked for the duplicate, but I now have empty lines where the ignored line is and the line numbering has gone wrong
2. It got the reference that was duplicated completely wrong

In the Output 2 page, the data is correct but the line numbering is all wrong:

So - where do I go from here!

Note that the real data has about 26 columns and thousands of lines so I'm trying to avoid too many loops.

 

[Fluff]

How about

Sub TheRedCardinal()
   Dim Ary As Variant, Oary1 As Variant, Oary2 As Variant
   Dim r As Long, r1 As Long, l2 As Long
   Dim Ws1 As Worksheet, Ws2 As Worksheet, Ws3 As Worksheet
   
   Set Ws1 = Sheets("Source Data")
   Set Ws2 = Sheets("Output 1")
   Set Ws3 = Sheets("Output 2")

   Ary = Ws1.Range("A1:F23").Value2
   
   ReDim Oary1(1 To 23, 1 To 4)
   ReDim Oary2(1 To 23, 1 To 3)
   
   For r = 2 To UBound(Ary)
      If Ary(r, 2) <> Ary(r - 1, 2) Then
         r1 = r1 + 1
         l2 = l2 + 1
         Oary1(r1, 1) = r1
         Oary1(r1, 2) = Ary(r, 3)
         Oary1(r1, 3) = Ary(r, 1)
         Oary1(r1, 4) = Ary(r, 6)
         
         Oary2(r, 1) = l2
         Oary2(r, 2) = Ary(r, 5)
         Oary2(r, 3) = Ary(r, 6)
      Else
         Oary1(r1, 4) = Oary1(r1, 4) + Ary(r, 6)
         Oary2(r, 1) = l2
         Oary2(r, 2) = Ary(r, 5)
         Oary2(r, 3) = Ary(r, 6)
      End If
   Next r
   Ws2.Range("A2").Resize(r1, UBound(Oary1, 2)).Value = Oary1
   Ws3.Range("A2").Resize(UBound(Oary2), UBound(Oary2, 2)).Value = Oary2
End Sub

 

[TheRedCardinal]

Hi Fluff - that seems to have worked perfectly. I will try to work it up into my bigger data now.

1 quick question, you have used ".value" and ".value2" - can I just ask what made you do that / why it was necessary?

 

[Fluff]

Just habit really.

 

[TheRedCardinal]

Good enough for me

You've provided me with a lot of help recently Fluff, it's gratefully received!

 

[Fluff]

Glad to help & thanks for the feedback.