Results 1 to 2 of 2
  1. #1
    Join Date
    Apr 2004
    Posts
    7

    Unanswered: Group by percentages

    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

    Range(Cells(iBotRow + 1, iSearchCol).Address, Cells(iBotRow + 3, iSearchCol).Address).EntireRow.Insert

    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. #2
    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
    badvalue = badvalue + 1
    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
  •