Consolidate repeated items in 2D array, remove empty data, and resize array

rkaczano

Board Regular
Joined
Jul 24, 2013
Messages
77
I have a 2D array that I know will have duplicate Text items in column 1.The array is already sorted so the duplicate items will be contiguous. I will have at most 3 repeated rows and at least 2 repeated rows.

I effectively want to consolidate the repeated rows, clear values in erroneous rows, and then resize the array (i.e. delete erroneous rows). To resize the array I will pass all the non empty rows to a dictionary and then back to a new smaller array.

Most all other columns have values as numbers which I will have to sum.

I am assuming my best approach will be to identify how may first column repeats exist by doing a first pass of the array by looping and creating an index.

[1,1,1,2,2,3,3,4,4,4,5,5,6,6,6,....

or an array that highlights the position of how may rows following are associated with the given row

[3,3,3,5,5,7,7,10,10,10,12,12,15,15,15 (i.e. first three rows repeat so rows 1-3 are tied to row 3).

Then use this index while looping through the array again to start the consolidation and clearing of data.

Does this sound like the right approach and if so, any ideas on how to create the index for the first pass?

Thanks
 

rkaczano

Board Regular
Joined
Jul 24, 2013
Messages
77
Really strange. The Immediate Window does show the results of the fist Debut.Print stmt (i.e. 282|6). But it is failing on the first transpose function AND I cannot seem to trap the error. The Error handler Goes to the line "eh:" but it does not print the error code to my immediate window. I used code tags on this post.

VBA Code:
Private Function ConsolidateArrayRows(v As Variant) As Variant
    
    Dim w As Variant, i As Long, j As Long, k As Long
    'Data
    ReDim w(1 To UBound(v, 1), 1 To 6)
    j = 1
    
    For i = 1 To UBound(v, 1)
    On Error GoTo eh
    
        If v(i, 1) <> w(j, 1) Then
            If w(j, 1) <> Empty Then j = j + 1
            For k = 1 To 6
                w(j, k) = v(i, k)
            Next
        Else
            If w(j, 2) = 0 And v(i, 2) = 0 Then
                w(j, 3) = Null
            Else
                w(j, 3) = WorksheetFunction.IfError((w(j, 3) * w(j, 2) + v(i, 3) * v(i, 2)) / (w(j, 2) + v(i, 2)), 0)
            End If
    
            w(j, 2) = w(j, 2) + v(i, 2)
            w(j, 4) = w(j, 4) + v(i, 4)
            w(j, 6) = w(j, 6) + v(i, 6)
        End If
    Next i
    
    Debug.Print UBound(w, 1) & "|" & UBound(w, 2)
    
    w = WorksheetFunction.Transpose(w)
    
    ReDim Preserve w(1 To 6, 1 To j)
    
    w = WorksheetFunction.Transpose(w)
    Debug.Print UBound(w, 1) & "|" & UBound(w, 2)
    
    ConsolidateArrayRows = w
  
eh:
      Debug.Print "An error occurred on line: " & Erl 
  
End Function
 

Some videos you may like

Excel Facts

Excel motto
Not everything I do at work revolves around Excel. Only the fun parts.

AlphaFrog

MrExcel MVP
Joined
Sep 2, 2009
Messages
16,358
Did you try it as I submitted? Application.Transpose
Yours is not the same.

Well done with the CODE tags.
 

rkaczano

Board Regular
Joined
Jul 24, 2013
Messages
77
Yes I did try that.

It fails on the Application.transpose line . It take right out of the function and also right out of subtroutine that that function is called in. And I cannot get it to trap the error. The reason I had changed it was higher up in the code I am using WorksheetFunction.IfError. I thought the syntax differences were causing the errors - but that does not seem to be the case.

In the Immediate Window I can test the array w as follows below right before the the code fails on the Application.transpose line. Clearly the array w is populated and clearly it has 284 rows and 6 columns.

I am at a loss at the moment...


?w(1,1)
AFG1
?Ubound(w,1)
284
?Ubound(w,2)
6
 

AlphaFrog

MrExcel MVP
Joined
Sep 2, 2009
Messages
16,358
This is a guess. If the array contains Null values, the transpose function errors according to this

Try changing this...
w(j, 3) = Null

To this...
w(j, 3) = ""
 

rkaczano

Board Regular
Joined
Jul 24, 2013
Messages
77

ADVERTISEMENT

When using "NULL" the loop completely finishes (283 loops) and the code fails on Application. The Error is Runtime Error 13 Type Mismatch.

When "" instead of "NULL" it fails on the 49th loop. Runtime Error 13 Type Mismatch.

It fails on this line of code:
w(j, 3) = WorksheetFunction.IfError((w(j, 3) * w(j, 2) + v(i, 3) * v(i, 2)) / (w(j, 2) + v(i, 2)), 0)

w(j, 3) inside the IfError function has a value of "". This creates a type mismatch

The "" value for w(j, 3) is from a previous iteration of the loop.

IMMEDIATE WINDOW
?V(i,1) & "|" & V(i,2) & "|" & V(i,3) & "|" & V(i,4) & "|" & V(i,5) & "|" & V(i,6)
BSC1|-0.0195|5|0|Type1|13

?(w(j, 3) & "*" & w(j, 2) & "+" & v(i, 3) & "*" & v(i, 2)) & "/" & (w(j, 2) & "+" & v(i, 2))
"" * 0 + 5 * -0.0195/0 + -0.0195

?WorksheetFunction.IfError((w(j, 3) * w(j, 2) + v(i, 3) * v(i, 2)) / (w(j, 2) + v(i, 2)), 0)
Runtime Error 13 Type Mismatch
 

Watch MrExcel Video

Forum statistics

Threads
1,118,076
Messages
5,570,070
Members
412,310
Latest member
mark884
Top