Thread: Macro Create Sum and Separate Zeroes Thanks:  1 Post #5297220 (1) Likes:  2 Post #5293729 (1)Post #5294917 (1)

1. 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")
.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!  Reply With Quote

2. 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
.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  Reply With Quote

3. 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  Reply With Quote

4. Re: Macro Create Sum and Separate Zeroes

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  Reply With Quote

5. Re: Macro Create Sum and Separate Zeroes

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

6. Re: Macro Create Sum and Separate Zeroes Originally Posted by unknownymous Thank you baitmaster & DanteAmor. I'll go for the simplified one.   Reply With Quote

User Tag List

Tags for this Thread

create, macro - formula, sum, sum = 0, vba  Posting Permissions

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