Results 1 to 4 of 4

Thread: Maintain Format

  1. #1
    Lounger
    Join Date
    Oct 2013
    Posts
    37
    Thanks
    5
    Thanked 0 Times in 0 Posts

    Maintain Format

    Hi,

    Below codes are successful in creating the summary but the format gets destroyed, Please some one help me to maintain the format.
    Create the Summary(Sheet 2) with same format, Column A as Text and Column B as Numeric with Decimal place of 2.
    Additional if possible Column A & B of sheet 2 Font Times New Roman, Font size 14.
    Thanks in advance.

    Sheet 1

    Sheet1.png

    Code:
    Sub Summary()
        Dim rng As Excel.Range
        Dim arrProducts() As String
        Dim i As Long
    
        Set rng = Sheet1.Range("L2:L20000")
    
        arrProducts = getSumOfCountArray(rng)
    
        Sheet2.Range("A1:B1").Value = Array("Leads", "Sum")
    
        ' go through array and output to Sheet2
        For i = 0 To UBound(arrProducts, 2)
            Sheet2.Cells(i + 2, "A").Value = arrProducts(0, i)
            Sheet2.Cells(i + 2, "B").Value = arrProducts(1, i)
        Next
    
    End Sub
    ' Pass in the range of the products
    Function getSumOfCountArray(ByRef rngProduct As Excel.Range) As String()
        Dim arrProducts() As String
        Dim i As Long, j As Long
        Dim index As Long
    
        ReDim arrProducts(1, 0)
    
        For j = 1 To rngProduct.Rows.Count
            index = getProductIndex(arrProducts, rngProduct.Cells(j, 1).Value)
            If (index = -1) Then
                ' create value in array
                ReDim Preserve arrProducts(1, i)
                arrProducts(0, i) = rngProduct.Cells(j, 1).Value ' product name
                arrProducts(1, i) = rngProduct.Cells(j, 2).Value ' count value
                i = i + 1
            Else
                ' value found, add to id
                arrProducts(1, index) = arrProducts(1, index) + rngProduct.Cells(j, 2).Value
            End If
        Next
    
        getSumOfCountArray = arrProducts
    End Function
    
    Function getProductIndex(ByRef arrProducts() As String, ByRef strSearch As String) As Long
        ' returns the index of the array if found
        Dim i As Long
        For i = 0 To UBound(arrProducts, 2)
            If (arrProducts(0, i) = strSearch) Then
                getProductIndex = i
                Exit Function
            End If
        Next
    
        ' not found
        getProductIndex = -1
    End Function

  2. #2
    3 Star Lounger Supershoe's Avatar
    Join Date
    Apr 2014
    Location
    Austin, TX
    Posts
    252
    Thanks
    1
    Thanked 36 Times in 34 Posts
    Can't you simply preformat the destination columns either manually or by macro before pasting values.
    Don Guillett
    Excel Developer
    dguillett @gmail.com

  3. #3
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,433
    Thanks
    371
    Thanked 1,456 Times in 1,325 Posts
    ZMagic,

    Here is some sample code to capture & apply formatting:

    Code:
    Option Explicit
    
    Sub Test()
    
       Dim zColLFmt As String
       Dim zColMFmt As String
       
       '*** Retrieve Source formatting ***
       zColLFmt = [L2].NumberFormat
       zColMFmt = [m2].NumberFormat
       
       '*** Apply Destination Formatting ***
       [A2].NumberFormat = zColLFmt
       [B2].NumberFormat = zColMFmt
          
    End Sub
    FYI: Don't let the "NumberFormat" throw you it will also get the text format.
    HTH
    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

  4. #4
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,629
    Thanks
    114
    Thanked 644 Times in 588 Posts
    This should also work

    Code:
    For i = 0 To UBound(arrProducts, 2)
      Sheet2.Cells(i + 2, "A").Value = arrProducts(0, i)
      Sheet2.Cells(i + 2, "A").NumberFormat = "@"
      Sheet2.Cells(i + 2, "B").Value = Format(arrProducts(1, i), "##,##0.00")
    Next
    HTH,
    Maud

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

    zmagic (2015-04-14)

Posting Permissions

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