Create Summary Table From Data


This Function Gives you summary of Two Columns Data , see the example below :

if you have Table like this :

India City 3
India City 4
US City 4
China City 2
China City 3
UK City 2
US City 4
China City 2
Germany City 3
China City 4
India City 3
Germany City 1
UK City 1
UK City 1
India City 1
India City 2
India City 1
Germany City 2
US City 3
UK City 2
 
You will have a summary after running this code :
 
  City 3 City 4 City 2 City 1 Total
India 2 1 1 2 6
US 1 2     3
China 1 1 2   4
UK     2 2 4
Germany 1   1 1 3
Total 5 4 6 5 20

 

 
Sub TransformArray(ArrData As Variant)
    
    Dim lngCirCD        As Long
    Dim lngAssngDate    As Long
    Dim lngCount        As Long
    Dim lngMatchRow     As Long
    Dim lngMatcCol      As Long
    Dim lngUboundArrRow As Long
    Dim lngLBArrRow     As Long
    Dim lngUBArrROw     As Long
    Dim lngLBArrCol     As Long
    Dim lngUBArrCol     As Long
    Dim lngUBArrdata    As Long
    Dim lngLBArrData    As Long
    Dim ArrAdd
    Dim ArrResult
    Dim ArrRow
    Dim arrCol
    Dim objDicCOl As Object
    Dim objDicRow As Object
        
        
    Dim rngSummary As Range
    Set rngSummary = Application.InputBox(“Please Select a Cell to Paste Summary”, , , , , , , 8)
    lngUBArrdata = UBound(ArrData)
    lngLBArrData = LBound(ArrData)
    
    Set objDicCOl = CreateObject(“Scripting.Dictionary”)
    Set objDicRow = CreateObject(“Scripting.Dictionary”)
    
    For lngCount = lngLBArrData To lngUBArrdata
        objDicRow.Item(ArrData(lngCount, 1)) = 0
    Next lngCount
    
    For lngCount = lngLBArrData To lngUBArrdata
        objDicCOl.Item(ArrData(lngCount, 2)) = 0
    Next lngCount
    With Application
    
        ArrRow = .Transpose(.Transpose(objDicRow.Keys))
        arrCol = .Transpose(.Transpose(objDicCOl.Keys))
        
        ReDim Preserve ArrRow(1 To UBound(ArrRow) + 1)
        ReDim Preserve arrCol(1 To UBound(arrCol) + 1)
        
        ArrRow(UBound(ArrRow)) = “Total”
        arrCol(UBound(arrCol)) = “Total”
        
        lngLBArrRow = LBound(ArrRow)
        lngUBArrROw = UBound(ArrRow)
        lngLBArrCol = LBound(arrCol)
        lngUBArrCol = UBound(arrCol)
        
        ReDim ArrResult(1 To objDicRow.Count + 2, 1 To lngUBArrCol + 1)
          
        For lngCount = lngLBArrRow To lngUBArrROw
            ArrResult(lngCount + 1, 1) = CStr(ArrRow(lngCount))
        Next
        
        For lngCount = lngLBArrCol To lngUBArrCol
            ArrResult(1, lngCount + 1) = CStr(arrCol(lngCount))
        Next
        
        lngUboundArrRow = lngUBArrROw + 1
        For lngCount = lngLBArrData To lngUBArrdata
                lngMatchRow = .Match(ArrData(lngCount, 1), ArrRow, 0) + 1
                lngMatcCol = .Match(ArrData(lngCount, 2), arrCol, 0) + 1
                ArrResult(lngMatchRow, lngMatcCol) = ArrResult(lngMatchRow, lngMatcCol) + 1
                ArrResult(lngUboundArrRow, lngMatcCol) = ArrResult(lngUboundArrRow, lngMatcCol) + 1
                lngMatcCol = .Match(“Total”, arrCol, 0) + 1
                ArrResult(lngMatchRow, lngMatcCol) = ArrResult(lngMatchRow, lngMatcCol) + 1
                ArrResult(lngUboundArrRow, lngMatcCol) = ArrResult(lngUboundArrRow, lngMatcCol) + 1
        Next lngCount
    End With
    
rngSummary.Resize(UBound(ArrResult), UBound(ArrResult, 2)).Value = ArrResult
 
End Sub
 
 ‘ Tested on 200000 Rows Data
Sub MTest()
 
    Debug.Print Now
        TransformArray (Range(“A1”).CurrentRegion)
    Debug.Print Now
    
End Sub
 

3 Comments Add yours

  1. Elias says:

    Why not just a Pivot Table?

    Regards

    1. Hi,
      thanks for your comment.
      well, yes pivot can be use for this purpose , objective of this code was that i could not use pivot in that project where it actually came from ,

      btw it’s fast and dont keep data copy in cache memory like pivot does.

      Regards
      Rajan.

  2. Anand says:

    We can use the combination of Advanced Filter and using sumproduct function we can still get the same result

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s