1. Registered User
Join Date
Apr 2004
Posts
7

Hello all!!

I have some macro code that will go through a contionus block of data and find different instances of A, seperate them out i.e. group, and then caluclate sums for the group respective columns and avereages for others. Im trying to get a macro that will go through Column P, which is one of the averaged columns at the end of each "group", and group the numbers. Coulmn P is a percent based column. I want the macro to from groups, whenever say a entire group is >50%. and then the next group would be anything <49% And >45%. I have tried several things now, and all I can get it to do is seperate every single percentage that is the same, like 52% and 52% would form a group and 51% and 51% would form a group instead of everything over 50% being an entire group by itself. I assume that it has to do with the fact that my previous code searched coulmn A for differences, but I tried different ways and got the same results. Does anyone have any suggestions??

SubInsertsumaverage
Dim iSearchCol As Integer
Dim iSumCol1 As Integer
Dim iSumCol2 As Integer
Dim iSumCol3 As Integer
Dim iSumCol4 As Integer
Dim iSumCol5 As Integer
Dim iSumCol6 As Integer
Dim iAveCol1 As Integer
Dim iAveCol2 As Integer
Dim iAveCol3 As Integer
Dim iTopRow As Integer
Dim iBotRow As Integer
Dim iRow As Integer

iSearchCol = Columns("A").Column

iSumCol1 = Columns("K").Column

iSumCol2 = Columns("L").Column

iSumCol3 = Columns("N").Column

iSumCol4 = Columns("O").Column

iSumCol5 = Columns("Q").Column

iSumCol6 = Columns("R").Column

iAveCol1 = Columns("M").Column

iAveCol2 = Columns("P").Column

iAveCol3 = Columns("S").Column

iRow = 1
Do While Cells(iRow, iSearchCol) <> ""
iTopRow = iRow
iRow = iRow + 1
Do While Cells(iTopRow, iSearchCol) = Cells(iRow, iSearchCol) And Cells(iRow, iSearchCol) <> ""
iRow = iRow + 1
Loop
iBotRow = iRow - 1

Cells(iRow, iSumCol1) = "=SUM(" & Cells(iTopRow, iSumCol1).Address & ":" & Cells(iBotRow, iSumCol1).Address & ")"

Cells(iRow, iSumCol2) = "=SUM(" & Cells(iTopRow, iSumCol2).Address & ":" & Cells(iBotRow, iSumCol2).Address & ")"

Cells(iRow, iSumCol3) = "=SUM(" & Cells(iTopRow, iSumCol3).Address & ":" & Cells(iBotRow, iSumCol3).Address & ")"

Cells(iRow, iSumCol4) = "=SUM(" & Cells(iTopRow, iSumCol4).Address & ":" & Cells(iBotRow, iSumCol4).Address & ")"

Cells(iRow, iSumCol5) = "=SUM(" & Cells(iTopRow, iSumCol5).Address & ":" & Cells(iBotRow, iSumCol5).Address & ")"

Cells(iRow, iSumCol6) = "=SUM(" & Cells(iTopRow, iSumCol6).Address & ":" & Cells(iBotRow, iSumCol6).Address & ")"

Cells(iRow, iAveCol1) = "=AVERAGE(" & Cells(iTopRow, iAveCol1).Address & ":" & Cells(iBotRow, iAveCol1).Address & ")"

Cells(iRow, iAveCol2) = "=AVERAGE(" & Cells(iTopRow, iAveCol2).Address & ":" & Cells(iBotRow, iAveCol2).Address & ")"

Cells(iRow, iAveCol3) = "=AVERAGE(" & Cells(iTopRow, iAveCol3).Address & ":" & Cells(iBotRow, iAveCol3).Address & ")"

iRow = iRow + 3

Loop

Range("K" & ActiveSheet.UsedRange.Rows.Count + 1) = Application.WorksheetFunction.Sum(Range("K:K").Spe cialCells(xlCellTypeFormulas, 1))

Range("L" & ActiveSheet.UsedRange.Rows.Count) = Application.WorksheetFunction.Sum(Range("L:L").Spe cialCells(xlCellTypeFormulas, 1))

Range("N" & ActiveSheet.UsedRange.Rows.Count) = Application.WorksheetFunction.Sum(Range("N:N").Spe cialCells(xlCellTypeFormulas, 1))

Range("O" & ActiveSheet.UsedRange.Rows.Count) = Application.WorksheetFunction.Sum(Range("O:O").Spe cialCells(xlCellTypeFormulas, 1))

Range("Q" & ActiveSheet.UsedRange.Rows.Count) = Application.WorksheetFunction.Sum(Range("Q:Q").Spe cialCells(xlCellTypeFormulas, 1))

Range("R" & ActiveSheet.UsedRange.Rows.Count) = Application.WorksheetFunction.Sum(Range("R:R").Spe cialCells(xlCellTypeFormulas, 1))

Range("M" & ActiveSheet.UsedRange.Rows.Count) = Application.WorksheetFunction.Average(Range("M:M") .SpecialCells(xlCellTypeFormulas, 1))

Range("P" & ActiveSheet.UsedRange.Rows.Count) = Application.WorksheetFunction.Average(Range("P:P") .SpecialCells(xlCellTypeFormulas, 1))

Range("S" & ActiveSheet.UsedRange.Rows.Count) = Application.WorksheetFunction.Average(Range("S").SpecialCells(xlCellTypeFormulas, 1))
Range("S" & ActiveSheet.UsedRange.Rows.Count).Select

Columns("K").SpecialCells(xlCellTypeFormulas, 1).EntireRow.Insert

Range("A" & ActiveSheet.UsedRange.Rows.Count).EntireRow.Insert

End Sub

2. Registered User
Join Date
Apr 2004
Location
Bothell, WA
Posts
4

## Re: Group by percentages

You wrote:
Im trying to get a macro that will go through Column P, which is one of the averaged columns at the end of each "group", and group the numbers. Coulmn P is a percent based column. I want the macro to from groups, whenever say a entire group is >50%. and then the next group would be anything <49% And >45%.

Q - I'm not sure what you're asking here, but I'll take a shot at it. I'm going to assume that column P has percentages in it, and you want to test the value of each cell in column P that has a value in it and determine which category (>50%,45-49%,40-45%, etc.) it falls into. If that is correct, then what do you want to happen next? Do you want a count of each value in P that falls into each of your categories, or do you want to insert a subtotal line?

If I'm correct in my assumptions above, then you might want to use Select Case, and categorize your percentages as each case and decide what you want it to do after it has figured out which case the cell falls into (i.e. have a counter for each case and increment it).

Here is some sample code:

Sub testcase()

Dim r, range1, range2, range3, range4, badvalue As Integer

r = 1

Do While Not (IsEmpty(Cells(r, 16))) 'where 16 is column P

Select Case Cells(r, 16)

Case Is > 0.5
range1 = range1 + 1
r = r + 1
Case Is > 0.45
range2 = range2 + 1
r = r + 1
Case Is > 0.4
range3 = range3 + 1
r = r + 1
Case Is > 0.3
range4 = range4 + 1
r = r + 1

Case Else
r = r + 1

End Select

Loop

End Sub

#### Posting Permissions

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