Macro Create Sum and Separate Zeroes
Results 1 to 6 of 6

Thread: Macro Create Sum and Separate Zeroes

  1. #1
    Board Regular
    Join Date
    Sep 2017
    Posts
    155
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Macro Create Sum and Separate Zeroes

    Hi Guys,

    Can you possibly help me clean up below codes? The range of cells with data is from A:AD

    1. Basically starting in AG5, I will create a sum formula from E5:T5 which will be copied down to the last non blank cell (not just till range 681).
    2. The macro will hardcode the sum column and sort by descending.
    3. If the sum total is zero it will create a separator by adding a row.
    4. Afterwards, delete the sum column


    Draft codes:
    ----------------------

    Sub Macrotest()


    ActiveCell.FormulaR1C1 = "=SUM(RC[-28]:RC[-13])"
    Range("AG5").Select
    Selection.Copy
    ActiveWindow.SmallScroll Down:=-12
    Range("AG5:AG681").Select
    ActiveSheet.Paste
    Rows("5:681").Select
    Range("AG5").Activate
    Application.CutCopyMode = False
    ActiveWorkbook.Worksheets("Macro Sheet").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Macro Sheet").Sort.SortFields.Add Key:=Range( _
    "AG5:AG681"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
    xlSortNormal
    With ActiveWorkbook.Worksheets("Macro Sheet").Sort
    .SetRange Range("A5:AG681")
    .Header = xlGuess
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
    End With
    Columns("AG:AG").Select
    Range("AG26").Activate
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Selection.End(xlUp).Select

    End Sub

    ----------------------------------

    Example Output (separate those with zero as total):

    QTY
    500
    100
    50
    20
    0
    0



    Any help will be much appreciated


    Thank you!

  2. #2
    Board Regular baitmaster's Avatar
    Join Date
    Mar 2009
    Location
    bristol, england
    Posts
    1,969
    Post Thanks / Like
    Mentioned
    2 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Macro Create Sum and Separate Zeroes

    I haven't added the row yet as I'm unclear what the requirement is. Do you just want to split the results table at the point [if] the first zero total is encountered?

    You'll note I've not used any Select, I'm always referring to the actual objects I want to work with

    Code:
    Option Explicit
    
    Sub Macrotest()
    
    
    ' create worksheet object, using VBA codename not Excel name
    Dim ws As Worksheet: Set ws = Sheet1
    
    
    ' create range objects for where formulas will be written
    Dim rngStart As Range: Set rngStart = ws.Range("AG5")
    Dim rngEnd As Range: Set rngEnd = ws.Cells(lastUsedRow(ws), rngStart.Column)
    
    
    With Range(rngStart, rngEnd)
        .FormulaR1C1 = "=SUM(RC[-28]:RC[-13])"                  ' write formulas
        .Value = .Value                                         ' convert to values
        
        With ws.Sort                                            ' perform sort feature
            .SortFields.Clear
            .SortFields.Add Key:=Range(rngStart, rngEnd), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
            .SetRange Range(Cells(rngStart.Row, 1), rngEnd)     ' looks at column 1, this could be changed if necessary
            .Header = xlGuess
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    
    
        .ClearContents                                          ' remove formulas
    
    
    End With
    
    
    End Sub
    
    
    
    
    Function lastUsedRow(ws As Worksheet) As Long
    ' function to find last used row of worksheet
    
    
    On Error Resume Next
        lastUsedRow = ws.Cells.Find("*", Range("A1"), xlFormulas, , xlByRows, xlPrevious).Row
    On Error GoTo 0
    
    
    End Function
    Baitmaster G



    Always save your work before running code from me, I probably haven't tested it and I'm not responsible when you lose all your work :p
    I aim to improve understanding so you can develop your own solutions, not do all your work for you. Write a clear requirement and you're more likely to get help

  3. #3
    Board Regular baitmaster's Avatar
    Join Date
    Mar 2009
    Location
    bristol, england
    Posts
    1,969
    Post Thanks / Like
    Mentioned
    2 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Macro Create Sum and Separate Zeroes

    additional code, now I've noticed the results table that explains what you want...

    Code:
        ' find change from non-zero to zero and insert a row
        Dim i As Integer
        For i = 2 To .Cells.Count
            If .Cells(i - 1, 1) > 0 And .Cells(i, 1) = 0 Then .Cells(i, 1).EntireRow.Insert
        Next i
        
        .ClearContents                                          ' remove formulas
    
    
    End With
    Last edited by baitmaster; Jun 13th, 2019 at 08:08 AM.
    Baitmaster G



    Always save your work before running code from me, I probably haven't tested it and I'm not responsible when you lose all your work :p
    I aim to improve understanding so you can develop your own solutions, not do all your work for you. Write a clear requirement and you're more likely to get help

  4. #4
    Board Regular DanteAmor's Avatar
    Join Date
    Dec 2018
    Location
    México
    Posts
    5,661
    Post Thanks / Like
    Mentioned
    64 Post(s)
    Tagged
    14 Thread(s)

    Default Re: Macro Create Sum and Separate Zeroes

    How about:

    Code:
    Sub Macrotest()
        Dim r As Range, f As Range
        Set r = Range("AG5:AG" & ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row)
        With r
            .FormulaR1C1 = "=SUM(RC[-28]:RC[-13])"
            .Value = .Value
            Range("A5", r).Sort key1:=Range("AG5"), order1:=xlDescending, Header:=xlNo
            Set f = .Find(0, LookIn:=xlValues, lookat:=xlWhole)
            If Not f Is Nothing Then f.EntireRow.Insert
            .ClearContents
        End With
    End Sub
    Regards Dante Amor

  5. #5
    Board Regular
    Join Date
    Sep 2017
    Posts
    155
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Macro Create Sum and Separate Zeroes

    Thank you baitmaster & DanteAmor. I'll go for the simplified one.

  6. #6
    Board Regular DanteAmor's Avatar
    Join Date
    Dec 2018
    Location
    México
    Posts
    5,661
    Post Thanks / Like
    Mentioned
    64 Post(s)
    Tagged
    14 Thread(s)

    Default Re: Macro Create Sum and Separate Zeroes

    Quote Originally Posted by unknownymous View Post
    Thank you baitmaster & DanteAmor. I'll go for the simplified one.
    I'm glad to help you. Thanks for the feedback.
    Regards Dante Amor

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

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