Results 1 to 2 of 2
  1. #1
    New Lounger
    Join Date
    Apr 2015
    Posts
    23
    Thanks
    11
    Thanked 0 Times in 0 Posts

    Sum Column B based on Column A and format it

    Hello,

    I need help to modifying this script, wherein i am getting the results but want them to formatted adding 2 decimal places and number #,##0.00
    Code:
    Sub doIt() 
             
        Dim data As Variant 
        Dim i As Long 
        Dim countDict As Variant 
        Dim category As Variant 
        Dim value As Variant 
             
        Set countDict = CreateObject("Scripting.Dictionary") 
             
        data = ActiveSheet.UsedRange 'Assumes data is in columns A/B
            
         'Populate the dictionary: key = category / Item = count
        For i = LBound(data, 1) To UBound(data, 1) 
            category = data(i, 1) 
            value = data(i, 2) 
            If countDict.exists(category) Then 
                countDict(category) = countDict(category) + value 'if we have already seen that category, add to the total
            Else 
                countDict(category) = value 'first time we find that category, create it
            End If 
        Next i 
            
         'Copy dictionary into an array
        ReDim data(1 To countDict.Count, 1 To 2) As Variant 
         
        Dim d As Variant 
        i = 1 
        For Each d In countDict 
            data(i, 1) = d 
            data(i, 2) = countDict(d) 
            i = i + 1 
        Next d 
              
         'Puts the result back in the sheet in column D/E, including headers
        With ActiveSheet 
            .Range("D1").Resize(UBound(data, 1), UBound(data, 2)) = data 
        End With 
         
    End Sub

    Product..Quotation
    1........4900000
    1........4900000
    1........100000
    1........300000000
    1........6000000
    2........1600000
    2........20000000
    2........1600000
    2........32879400
    Product Row Occurrence Quotation
    1....................5................315900000 Result 315900000 will be converted to 31,59,000.00
    2....................4................56079400 Result 56079400 will be converted to 5,60,794.00

    Is it possible for Each cycle to retrieve also the number of occurrences?
    Example:
    Product # 1 have 5 occurrences
    Product # 2 have 4 occurrences

    Sample File attached.
    Posted also at
    http://www.vbaexpress.com, no help.


    Attached Files Attached Files

  2. #2
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,639
    Thanks
    115
    Thanked 651 Times in 593 Posts
    danny,

    Several ways to do this. Here is a quick way (note the changes in blue):

    Code:
    Sub doIt()
    
      Dim data As Variant
      Dim i As Long
      Dim countDict As Variant
      Dim category As Variant
      Dim value As Variant
    
      Set countDict = CreateObject("Scripting.Dictionary")
    
      data = ActiveSheet.UsedRange 'Assumes data is in columns A/B
    
      'Populate the dictionary: key = category / Item = count
      For i = LBound(data, 1) To UBound(data, 1)
        category = data(i, 1)
        If i = LBound(data, 1) Then
            value = data(i, 2)
        Else:
            value = data(i, 2) / 100
        End If
        If countDict.exists(category) Then
          countDict(category) = countDict(category) + value 'if we have already seen that category, add to the total
        Else
          countDict(category) = value 'first time we find that category, create it
        End If
      Next i
    
      'Copy dictionary into an array
      ReDim data(1 To countDict.Count, 1 To 2) As Variant
    
      Dim d As Variant
      i = 1
      For Each d In countDict
        data(i, 1) = d
        data(i, 2) = countDict(d)
        i = i + 1
      Next d
    
      'Puts the result back in the sheet in column D/E, including headers
      With ActiveSheet
        .Range("D1").Resize(UBound(data, 1), UBound(data, 2)).NumberFormat = "#,##0.00"
        .Range("D1").Resize(UBound(data, 1), UBound(data, 2)) = data
        
      End With
    
    End Sub
    HTH,
    Maud

  3. The Following User Says Thank You to Maudibe For This Useful Post:

    danny69 (2015-04-27)

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •