Fastest and easiest way to consolidate duplicates- Excel worksheet 1

[ItIsHardToProgram]

Hello everyone,

I am currently trying to find a way to EFFECTIVELY consolidate all recuring data in a dynamic and fast way.

Let me explain.

I have data that I get monthly.

The data consists in fees / minutes etc... and Categories sub categories etc....

What I want to do, is have only one category with minutes and fees consolidated.


For example:

lets say I have this:

Anna 3
George 2
Anna 4
George 2

I want my data to look like this:

Anna 7
George 4

Thanks for your help every one, I am looking for rough ideas or references, not necesserely coding, although it might help.

Don't forget I am trying to find the FASTEST WAY (optimized) to do this.

I can think of many iterations but that would be very slow and heavy.

Thank you all.

"Knowing that you know is the greatest sign of stupidity, knowing that you are ignorant is the best proof of intelligence.

 

[SkipVought]

hi,

You could use a PivotTable (might take 10 seconds to set up and 2 seconds to refresh)

You could use MS Query (might take 30 seconds to set up and 2 seconds to refresh)

You could Sort on column A and use the Subtotal feature (might take 15 seconds to set up and 2 seconds to refresh)

Skip,
[sup]Don't let the Diatribe...
talk you to death![/sup][sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[ItIsHardToProgram]

So you are suggesting a pivot table, wich is what I am currently considering.

Just thought there would be better way, Ok, thank you any way, its always a pleasure.

Julien ~

"Knowing that you know is the greatest sign of stupidity, knowing that you are ignorant is the best proof of intelligence.

 

[SkipVought]

What, is that not fast enough for you?

Skip,
[sup]Don't let the Diatribe...
talk you to death![/sup][sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[ItIsHardToProgram]

It is fast, but as you probably understand by now I am not fond of pivot table, I seem to have encountered an unfixable problem wich scares me when approaching the mechanics of pivot tables.

See the following, in wich you participated.

http://www.tek-tips.com/viewthread.cfm?qid=1492096&page=1

Either way, my project works and I will paste my code for public knowledge, since everyone participated (mostly you) in the production of this project.

Option Explicit
Dim iCell As Integer, iColumn As Integer, iLine, j As Integer, i As Integer, iOffset As Integer
Dim iMaxCell As Integer
Dim iSheet As Integer, iWorkbooks As Integer, iWorksheets As Integer
Dim sColumnName As String
Dim dMoyenne As Double
Dim pi As PivotItem

Dim bidon

Dim sColumn As String
Function ConvertToLetter(iCol As Integer)
'Conversion du chiffre de la boucle en lettre (pour référencement)
   
   Dim iAlpha As Integer
   Dim iRemainder As Integer
   iAlpha = Int(iCol / 27)
   iRemainder = iCol - (iAlpha * 26)
   
   If iAlpha > 0 Then
      sColumn = Chr(iAlpha + 64)
   End If
   
   If iRemainder > 0 Then
      sColumn = sColumn & Chr(iRemainder + 64)
   End If


End Function

Sub TriMOB()

'Code pour voir combien de donner sur quel étendu.

iOffset = 2


Worksheets("TableauFinal").Activate
With Worksheets("TableauFinal")
    .Range("A2:E65536").Select
    Selection.ClearContents
    .Range("J2:M65536").Select
    Selection.ClearContents
    .Range("O2:AA65536").Select
    Selection.ClearContents
    .Range("AD2:AF65536").Select
    Selection.ClearContents
End With

For iSheet = 1 To Worksheets.Count
    Select Case Worksheets(iSheet).Name
            
            Case "RDY_MOB_Month1", "RDY_MOB_Month2", "RDY_MOB_Month3"
                
                               
                Worksheets(iSheet).Activate
                Worksheets(iSheet).Rows("3:562").Select
                Selection.Sort Key1:=Worksheets(iSheet).Range("A3"), Order1:=xlAscending, Header:=xlGuess, _
                    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                    DataOption1:=xlSortNormal
                    
                    For iMaxCell = 1 To 20000
                        If Worksheets("RDY_MOB_Month1").Cells(iMaxCell, 1).FormulaR1C1 = "" Then
                              Exit For
                        End If
                    Next iMaxCell
            
    

For iColumn = 1 To 200
    For j = 1 To 200
            
            If Worksheets(iSheet).Cells(1, iColumn).FormulaR1C1 = Worksheets("TableauFinal").Cells(1, j).FormulaR1C1 And Worksheets("TableauFinal").Cells(1, j) <> "" Then
            
            Call ConvertToLetter(iColumn)
            
            Worksheets(iSheet).Range(sColumn & "3:" & sColumn & iMaxCell).Copy
            sColumn = ""
            
            Call ConvertToLetter(j)
            Worksheets("TableauFinal").Select
            Range(sColumn & iOffset).Select
                        
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
            
            sColumn = ""
            End If
    Next j
            
Next iColumn
    iOffset = iOffset + iMaxCell
    End Select
Next iSheet
    
    Worksheets("TableauFinal").Columns("A:AF").Select
    Selection.Sort Key1:=Worksheets("TableauFinal").Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    
    Worksheets("TableauFinal").Range("W2:Y65536").Select
    Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

    Worksheets("Total").PivotTables("TableauTotal").PivotCache.Refresh
    
Call DynamicSdev

Call FilterContingency


End Sub

Sub DynamicSdev()

Dim dSdev As Double

For Each pi In Worksheets("Total").PivotTables("TableauTotal").PivotFields("Surname             ").PivotItems
    pi.Visible = True
Next


For iColumn = 13 To 14
iOffset = 0
For iCell = 16 To 20000
    If Worksheets("Total").Cells(iCell, iColumn).Value > 0 Then
           iOffset = iOffset + 1
           dSdev = dSdev + (Worksheets("Total").Cells(iCell, iColumn).Value - Worksheets("Total").Cells(5, iColumn + 6)) ^ 2
           dMoyenne = dMoyenne + Worksheets("Total").Cells(iCell, iColumn).Value
    End If
Next iCell
    
    Worksheets("Total").Cells(4, iColumn).Value = iOffset
    
    dMoyenne = dMoyenne / iOffset
    dSdev = Sqr(1 / iOffset * dSdev)
    
    Worksheets("Total").Cells(5, iColumn).Value = Worksheets("Total").Cells(5, iColumn + 6).Value
    Worksheets("Total").Cells(6, iColumn).Value = dSdev
    
    Worksheets("Total").Cells(8, iColumn).Value = dMoyenne + 2 * dSdev

Next iColumn
End Sub

Sub FilterContingency()

Dim icelloffset As Integer

Worksheets("Total").Activate


icelloffset = 16
For iCell = 16 To 20000
    
    If Worksheets("Total").Cells(icelloffset, 4).Value = "" Then
        Exit For
    End If
    
    With Worksheets("Total").PivotTables("TableauTotal").PivotFields("Surname             ")
        .PivotItems(Worksheets("Total").Cells(icelloffset, 4).Value).Visible = True
    End With
    
    
    Select Case Worksheets("Total").Cells(icelloffset, 6).FormulaR1C1
        
        Case "BB"
            If Worksheets("Total").Cells(icelloffset, 8).Value < Worksheets("Total").Cells(8, 13).Value Then
                With Worksheets("Total").PivotTables("TableauTotal").PivotFields("Surname             ")
                    .PivotItems(Worksheets("Total").Cells(icelloffset, 4).Value).Visible = False
                End With
                
            Else
            icelloffset = icelloffset + 1
                
            End If
        Case "Cell"
            If Worksheets("Total").Cells(icelloffset, 8).Value < Worksheets("Total").Cells(8, 14).Value Then
                With Worksheets("Total").PivotTables("TableauTotal").PivotFields("Surname             ")
                    .PivotItems(Worksheets("Total").Cells(icelloffset, 4).Value).Visible = False
                End With
            Else
            icelloffset = icelloffset + 1
            
            End If
    End Select
Next iCell
End Sub

"Knowing that you know is the greatest sign of stupidity, knowing that you are ignorant is the best proof of intelligence.

 

[ItIsHardToProgram]

Oh, I forgot, the total process, with the iterations and the pivot items to hide and show, takes around 4 minutes.

I can live with that I guess.

Thanks for your help skip, have a star.

"Knowing that you know is the greatest sign of stupidity, knowing that you are ignorant is the best proof of intelligence.

 

[SkipVought]

Use MS Query. Formatting "sticks." (and my nose is NOT stuffed) ;-)

Skip,
[sup]Don't let the Diatribe...
talk you to death![/sup][sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[ItIsHardToProgram]

I am afraid the MSquery component is not installed on my desktops or laptops, and there is over 125 computers, some of wich might use this, considering this fact we did not want to have to add any components to any computers, Wich is what I was requested, or I would have added a PDF print with Distiller 5.0

"Formatting "sticks." (and my nose is NOT stuffed) "

Not sure I get you there, although I still have to take care of the format of the pivot table, but that hopefuly won't be a problem

stuffed???

I am clueless, I guess it is my lack of english proverbs?





"Knowing that you know is the greatest sign of stupidity, knowing that you are ignorant is the best proof of intelligence.

 

[PHV]

FYI, a simpler way for one of your function:
Function ConvertToLetter(iCol As Integer)
sColumn = Split(Columns(iCol).Address(False, False), ":")(0)
End Function

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[ItIsHardToProgram]

Ty for this addition,

"Knowing that you know is the greatest sign of stupidity, knowing that you are ignorant is the best proof of intelligence.

 

[ItIsHardToProgram]

Can any of you guys think of a faster iteration than this:

Sub FilterContingency()

Dim icelloffset As Integer

Worksheets("Total").Activate


icelloffset = 16
For iCell = 16 To 20000
    
    If Worksheets("Total").Cells(icelloffset, 4).Value = "" Then
        Exit For
    End If
    
    With Worksheets("Total").PivotTables("TableauTotal").PivotFields("Surname             ")
        .PivotItems(Worksheets("Total").Cells(icelloffset, 4).Value).Visible = True
    End With
    
    
    Select Case Worksheets("Total").Cells(icelloffset, 6).FormulaR1C1
        
        Case "BB"
            If Worksheets("Total").Cells(icelloffset, 8).Value < Worksheets("Total").Cells(8, 13).Value Then
                With Worksheets("Total").PivotTables("TableauTotal").PivotFields("Surname             ")
                    .PivotItems(Worksheets("Total").Cells(icelloffset, 4).Value).Visible = False
                End With
                
            Else
            icelloffset = icelloffset + 1
                
            End If
        Case "Cell"
            If Worksheets("Total").Cells(icelloffset, 8).Value < Worksheets("Total").Cells(8, 14).Value Then
                With Worksheets("Total").PivotTables("TableauTotal").PivotFields("Surname             ")
                    .PivotItems(Worksheets("Total").Cells(icelloffset, 4).Value).Visible = False
                End With
            Else
            icelloffset = icelloffset + 1
            
            End If
    End Select
Next iCell
End Sub

This Greatly slows down my procedures, as it is long...

a little less then a second per items...

Thats a couple of minutes for 400 items.

"Knowing that you know is the greatest sign of stupidity, knowing that you are ignorant is the best proof of intelligence.

 

[WinblowsME]

How about using a dictionary object?

 

[ItIsHardToProgram]

Care to elaborate?

Thanks

"Knowing that you know is the greatest sign of stupidity, knowing that you are ignorant is the best proof of intelligence.

 

[WinblowsME]

'----------------------------
'       | Column A | Column B
'----------------------------
' Row 1 | Anna     | 3    
' Row 2 | George   | 2
' Row 3 | Anna     | 5
' Row 4 | George   | 2

Sub Consolidate()
   Dim dict As Object, curr_key As Variant
   Dim curr_name As String, curr_amount As Long, i As Long

   Set dict = CreateObject("Scripting.Dictionary")

   For i = 1 To 5
      curr_name = Trim(Cells(i, 1))

      If curr_name <> "" Then
         curr_amount = CLng(Cells(i, 2))
         dict.Item(curr_name) = dict.Item(curr_name) + curr_amount
      Else
         Exit For
      End If
   Next
   
   For Each curr_key In dict.keys
      Debug.Print curr_key & " " & dict.Item(curr_key)
   Next
End Sub