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

TheRedCardinal

Board Regular
Joined
Jul 11, 2019
Messages
169
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:

1601657304705.png


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):

1601657526434.png


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:

1601657770626.png


I tried the following code:

VBA 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
1601658952647.png


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

1601659054040.png


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.
 

Some videos you may like

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
55,819
Office Version
  1. 365
Platform
  1. Windows
How about
VBA Code:
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

Board Regular
Joined
Jul 11, 2019
Messages
169
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

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
55,819
Office Version
  1. 365
Platform
  1. Windows
Just habit really.
 

TheRedCardinal

Board Regular
Joined
Jul 11, 2019
Messages
169
Good enough for me :)

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

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
55,819
Office Version
  1. 365
Platform
  1. Windows
Glad to help & thanks for the feedback.
 

Watch MrExcel Video

Forum statistics

Threads
1,128,173
Messages
5,629,157
Members
416,368
Latest member
PaoloC

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top