Sum through a column and group the rows found

adforest2010 · Oct 9th 2010

Hello to all:

Hello

I have a worksheet with over 35,000 rows. I need to find a the target sum of “52800” or the closest to the target sum in Column “G”, insert a row below it and insert the value of the first row & the Value of the last Row In Column (“H?”). On my worksheet column (“H”) will be column (“T”).
Then I will need to group the ranges of the found sums.
I have given an example in the attached workbook Sheet1. Can you help me with coding that will duplicate this in a Macro?

Rob Xaos · Oct 10th 2010

Re: Sum through a column and group the rows found

Can you clarify the following:

In your description you say 'closest to the target sum', I would interpret this as when ABS(52800-SUM(CurrentRange)) reaches a minimum, where CurrentRange is from the row after the last insertion (or start) to the current row. However in your example Workbook at lines 198, 199, 200 it seems you are inserting the row before SUM(CurrentRange)>52800. Can you confirm which of these is the requirement?

adforest2010 · Oct 10th 2010

Re: Sum through a column and group the rows found

Hello Rob

Thank you for your responce to my question. 52800 repesents 10 mile intreviles. I need to be somewhere with 200 <> that total. I could round up or down depending on rather the sum is <> my target.The grouping is set that I may chart and graph the sum points in the next step.

I hope this helps I have been working on this for a week and can't get past this point.

Rob Xaos · Oct 10th 2010

Re: Sum through a column and group the rows found

Hmm,

It seems to me that column G is a series of increasing numbers, as in possibly cumulative distance from a start point. It does not seem to make sense to sum this again.

Can I suggest you explain the whole problem from the beginning. The issue may be that the approach needs to be revised.

adforest2010 · Oct 10th 2010

Re: Sum through a column and group the rows found

Okay Rob I see what is wrong with my example in my haste to copy and paste I omitted a Column. Please see the new attachment.

The distance from last annomaly column is the one which needs to be sum of “52800” or the closest to the target sum <200 or >200 of 52800 I can round up or down to produce the graph.

adforest2010 · Oct 11th 2010

Re: Sum through a column and group the rows found

Hello Rob have you gotten a chance to look at the follow up Post I sent

Rob Xaos · Oct 11th 2010

Re: Sum through a column and group the rows found

What you are describing here on the forums and what you have provided as an example do not match up. The nature of your data is such that it is not possible to gaurantee that the sum will be within 200 units of 52800.

Try Autofilling the following formula down column J:
=ABS(SUM($G$2:G2)-52800)

Your first new row occurs at 216.42, which is the minimum but not < 200. If you then restart the above formula as:
=ABS(SUM($G$144:G144)-52800)

Autofill that down to the next inserted row, that occurs at 2162.74 which is certainly not < 200 and is not even the minimum, which would be if you included the figures from row 200.
If the same process is carried out on column H instead of G then the sum never gets close to 52800.

You need to look at this again yourself, work out what you actually need then explain that accurately.

adforest2010 · Oct 12th 2010

Re: Sum through a column and group the rows found

Thanks Rob for your help, but I think you missed the Thread posted from the start.
"I have a worksheet with over 35,000 rows. I need to find a the target sum of “52800” or the closest to the target sum in Column “G”, insert a row below it and insert the value of the first row & the Value of the last Row In Column (“H?”). On my worksheet column (“H”) will be column (“T”).
Then I will need to group the ranges of the found sums.
I have given an example in the attached workbook Sheet1. Can you help me with coding that will duplicate this in a Macro? "
Thats all I need.The answer you supplied will not work because the row numbers will never be the same.

Rob Xaos · Oct 12th 2010

Re: Sum through a column and group the rows found

I have read your post from the start. I understand completely that it is not fixed row numbers that it is based on the data in your columns. The point you are missing is that what you are describing as criteria for when to insert the row and your example do not match and when I have asked for clarification your explanations have made less sense not more.

I cannot help you. Perhaps someone else will.

adforest2010 · Oct 12th 2010

Re: Sum through a column and group the rows found

Thanks

adforest2010 · Oct 20th 2010

Re: Sum through a column and group the rows found

To any one that may need this the answer was given to me by xxxxxxxx@xxxxxx [EMAIL ADDRESS REMOVED BY MODERATOR]

I thing it is very cool...

Code

Option Explicit
Sub ClearTotals()
 
Dim Msg
Dim DelRow As Long
Dim LastRow As Long
Dim ColForTotals As String
'Speed
Application.ScreenUpdating = False
 
'Get last row of data, Col A
LastRow = Range("A" & Rows.Count).End(xlUp).Row
 
'Start clean
On Error Resume Next
Range("A1:A" & LastRow).Rows.Ungroup
On Error GoTo endo
Cells.EntireRow.Hidden = False
 
'Get info
If Range("ColForTotals") = "" Then
Msg = MsgBox("Missing or invalid destination column letter. Stopping.", vbOKOnly + vbExclamation, "Column required")
Else
ColForTotals = Range("ColForTotals")
End If
 
'Delete rows in totals col
DelRow = Cells(Rows.Count, ColForTotals).End(xlUp).Row
Do While DelRow > 3
Cells(DelRow, 1).EntireRow.Delete
DelRow = Cells(Rows.Count, ColForTotals).End(xlUp).Row
Loop
 
'Go Home
Range("A3").Select
ActiveWindow.ScrollRow = 1
 
'Reset
Application.ScreenUpdating = True
'Completed normally
Exit Sub
'Errored out
endo:
Msg = MsgBox(Err.Description, vbOKOnly + vbCritical, Err.Number)
 
End Sub
Sub DoTotals()
Dim Msg
Dim i As Long
Dim cTotal As Long
Dim DelRow As Long
Dim LastRow As Long
Dim cAsc1 As Boolean
Dim cAsc2 As Boolean
Dim cAsc3 As Boolean
Dim FirstRow As Long
Dim TotalNow As Double
Dim RowCounter As Long
Dim ColToSum As String
Dim TotalToHit As Double
Dim ColForTotals As String
Dim FirstRowInfo As Double
'Speed
Application.ScreenUpdating = False
 
'Get settings
If Range("ColToSum") = "" Then
On Error Resume Next
ColToSum = InputBox("Please enter letter(s) for source column", "Column required", "G")
On Error GoTo 0
Else
ColToSum = Range("ColToSum")
End If
 
'Get each letter
If Len(CStr(ColToSum)) = 1 Then
'Check it
cAsc1 = NotCol(Asc(UCase(CStr(ColToSum))))
ElseIf Len(CStr(ColToSum)) = 2 Then
cAsc1 = NotCol(Asc(UCase(Left(CStr(ColToSum), 1))))
cAsc2 = NotCol(Asc(UCase(Right(CStr(ColToSum), 1))))
ElseIf Len(CStr(ColToSum)) = 3 Then
cAsc1 = NotCol(Asc(UCase(Left(CStr(ColToSum), 1))))
cAsc2 = NotCol(Asc(UCase(Mid(CStr(ColToSum), 2, 1))))
cAsc3 = NotCol(Asc(UCase(Right(CStr(ColToSum), 1))))
End If
 
If ColToSum = "" Or Len(CStr(ColToSum)) > 3 Or cAsc1 = True Or cAsc2 = True Or cAsc3 = True Then
Msg = MsgBox("Missing or invalid source column letter.", vbOKOnly + vbExclamation, "Column required")
Range("ColToSum").Select
GoTo NoCol
Else
Range("ColToSum") = ColToSum
End If
 
'Get settings
If Range("ColForTotals") = " " Then
On Error Resume Next
ColForTotals = InputBox("Please enter letter(s) for destination column", "Column required", "H")
On Error GoTo 0
Else
ColForTotals = Range("ColForTotals")
End If
 
'Get each letter
If Len(CStr(ColForTotals)) = 1 Then
'Check it
cAsc1 = NotCol(Asc(UCase(CStr(ColForTotals))))
ElseIf Len(CStr(ColForTotals)) = 2 Then
cAsc1 = NotCol(Asc(UCase(Left(CStr(ColForTotals), 1))))
cAsc2 = NotCol(Asc(UCase(Right(CStr(ColForTotals), 1))))
ElseIf Len(CStr(ColForTotals)) = 3 Then
cAsc1 = NotCol(Asc(UCase(Left(CStr(ColForTotals), 1))))
cAsc2 = NotCol(Asc(UCase(Mid(CStr(ColForTotals), 2, 1))))
cAsc3 = NotCol(Asc(UCase(Right(CStr(ColForTotals), 1))))
End If
 
If ColForTotals = "" Or Len(CStr(ColForTotals)) > 3 Or cAsc1 = True Or cAsc2 = True Or cAsc3 = True Then
Msg = MsgBox("Missing or invalid destination column letter.", vbOKOnly + vbExclamation, "Column required")
Range("ColForTotals").Select
GoTo NoCol
Else
Range("ColForTotals") = ColForTotals
End If
'Get settings
If Range("TotalToHit") = "" Or Range("TotalToHit") = 0 Then
On Error Resume Next
TotalToHit = InputBox("Please enter Number to sum up to but not exceed", "Amount required", "52800")
On Error GoTo 0
End If
 
If Range("TotalToHit") = 0 Or Not IsNumeric(TotalToHit) Then
Msg = MsgBox("Missing or invalid Number", vbOKOnly + vbExclamation, "Amount required")
Range("TotalToHit").Select
GoTo NoCol
Else
TotalToHit = Range("TotalToHit")
End If
 
'Get last row of data, Col A
LastRow = Range("A" & Rows.Count).End(xlUp).Row
 
'Start clean
On Error Resume Next
Range("A1:A" & LastRow).Rows.Ungroup
' On Error GoTo endo
Cells.EntireRow.Hidden = False
 
'Delete rows in totals col Col "H" ("T")
DelRow = Cells(Rows.Count, ColForTotals).End(xlUp).Row
Do While DelRow > 3
Cells(DelRow, 1).EntireRow.Delete
DelRow = Cells(DelRow, ColForTotals).End(xlUp).Row
Loop
 
'Init
FirstRow = 2
FirstRowInfo = Cells(2, ColToSum)
 
'Do all rows
For RowCounter = FirstRow To LastRow
'Check if less than goal
If TotalNow < TotalToHit Then
'Yes, add next
TotalNow = TotalNow + Cells(RowCounter, ColToSum)
Else
'Exceeded goal = roll back 1 row
TotalNow = TotalNow - Cells(RowCounter, ColToSum)
'Insert row for rows info
Cells(RowCounter - 1, ColToSum).EntireRow.Insert
'Put rows info
Cells(RowCounter - 1, ColForTotals) = FirstRowInfo & "-" & Cells(RowCounter - 2, "G")
'Save new startrow value
FirstRowInfo = Cells(RowCounter, "G")
'Group rows
Range(Cells(FirstRow, "A"), Cells(RowCounter - 2, "A")).Rows.Group
'Save new first row for groups
FirstRow = Cells(RowCounter, ColToSum).Row
'Check if > 50 % (No chance of new...)
If Cells(RowCounter, ColToSum) > TotalToHit / 2 Then GoTo AllDone
'Reset by getting next (inserted row) if less than 1
TotalNow = Cells(RowCounter, ColToSum)
End If
'Do next 'batch' of rows
Next RowCounter
 
AllDone:
'Format
Columns(ColForTotals).EntireColumn.AutoFit
'Collapse all
ActiveSheet.Outline.ShowLevels RowLevels:=2
'Go home
ActiveWindow.ScrollRow = 1
 
NoCol:
Columns("S:S").Select
Selection.Font.Bold = True
Range("R1").Select
'Reset
Application.ScreenUpdating = True
'Completed normally
Exit Sub
'Errored out
endo:
Msg = MsgBox(Err.Description, vbOKOnly + vbCritical, Err.Number)
End Sub
Function NotCol(num As Long)
 
If num < 65 Or num > 90 Then NotCol = True
End Function
Sub DelRows()
Dim i As Long
Dim d As Long
d = Cells(Rows.Count, 1).End(xlUp).Row
For i = d To 3 Step -1
If Cells(i, 1) = "" Then
Cells(i, 1).EntireRow.Delete
End If
Next i
End Sub

Display More

Rob Xaos · Oct 21st 2010

Re: Sum through a column and group the rows found

I'm glad you were able to find a solution. Please remember that for any future posts you make any VBA code must be wrapped in [noparse]

Code

[/noparse] tags.

Also, public forums like this are constantly scanned by Bots to harvest email addresses. The person who wrote your code for you is unlikely to be pleased if their email address is added to the list of these Bots as a target for Spam. I have therefore removed the email address.

adforest2010 · Oct 21st 2010

Re: Sum through a column and group the rows found

Thanks Your help got me on the right track. However now that I am able to handle the grouping I have run into a problem with the Charts because the Sheet names for the data range change with each new Import.

Sum through a column and group the rows found

Participate now!

Share