+ Reply to Thread
Results 1 to 7 of 7

averaging a column based on criteria andputting result in new worksheet

  1. #1
    Registered User
    Join Date
    01-19-2007
    Posts
    4

    Exclamation averaging a column based on criteria andputting result in new worksheet

    Thanks for your help in advance. Much appreciated.
    ---------------------------------------------------
    I have 2 worksheets.. Data and Report

    Data has 5 columns..
    Date, Name, ClassGroup, ItemsOrdered and AmountSpent

    I need to figure out the VBA code to do the following

    1. Sum all the ItemsOrdered where ClassGroup = Math and store that value on worksheet called Report (there may or maynot be blank cells in this column)

    2. I need to loop this and do it for every Class group storing each Sum in a differentcell on report.

  2. #2
    Valued Forum Contributor
    Join Date
    07-11-2004
    Posts
    851
    why a macro - not that a macro won't do it? You could get the unique classgroups via data, Filter, advanced and copy this list onto your report worksheet, and then get your average using sumif, countif, or average(if, or more ways.
    not a professional, just trying to assist.....

  3. #3
    Registered User
    Join Date
    01-19-2007
    Posts
    4
    Because this needs ot be called after a user gives input to determine the amount of data supplied.

  4. #4
    Valued Forum Contributor
    Join Date
    07-11-2004
    Posts
    851
    it's not perfect, but functional

    Sub macro1()
    '100 possible glassgroups
    Dim classgroup(100)
    Dim item(100)
    Dim count(100)
    'read in all unique classgroups
    'header cell of classgroup column named classgroup
    'header cell of itemsordered column named itemsordered
    firstrow = Range("classgroup").Row + 1
    lastrow = Range("classgroup").End(xlDown).Row
    classcolumn = Range("classgroup").Column
    itemcolumn = Range("itemsordered").Column
    Sheets("Data").Activate
    j = 1
    For i = firstrow To lastrow
    For k = 1 To j
    If Cells(i, classcolumn).Value = classgroup(k) Then GoTo nexti _
    Else classgroup(j) = Cells(i, classcolumn).Value
    If i < lastrow Then j = j + 1
    If i = lastrow Then GoTo done
    GoTo nexti
    Next k
    nexti:
    Next i
    done:
    'sum up items for each classgroup
    For l = 1 To j
    For i = firstrow To lastrow
    If Cells(i, classcolumn) = classgroup(l) Then item(l) = item(l) _
    + Cells(i, itemcolumn)
    Next i
    Next l
    'count occurances of each classgroup
    For l = 1 To j
    For i = firstrow To lastrow
    If Cells(i, classcolumn) = classgroup(l) Then count(l) = count(l) _
    + 1
    Next i
    Next l
    Sheets("Report").Activate
    ' place classgroups in column A and average of items ordered in column B
    ' starting in row 2
    For l = 1 To j
    Cells(l + 1, 1).Value = classgroup(l)
    If count(l) <> 0 Then _
    Cells(l + 1, 2).Value = item(l) / count(l)
    Next l
    End Sub

  5. #5
    Valued Forum Contributor
    Join Date
    07-11-2004
    Posts
    851
    a little better and will exclude blanks from the averages

    Sub macro1()
    Sheets("Data").Activate
    '100 possible glassgroups
    Dim classgroup(100)
    'header cell of classgroup column named classgroup
    'header cell of itemsordered column named itemsordered
    firstrow = Range("classgroup").Row + 1
    lastrow = Range("classgroup").End(xlDown).Row
    classcolumn = Range("classgroup").Column
    itemcolumn = Range("itemsordered").Column
    Range(Cells(firstrow, itemcolumn), _
    Cells(lastrow, itemcolumn)).Name = "itemlist"
    Range(Cells(firstrow, classcolumn), _
    Cells(lastrow, classcolumn)).Name = "classlist"
    Sheets("Data").Activate
    'read in all unique classgroups
    j = 1
    For i = firstrow To lastrow
    For k = 1 To j
    If Cells(i, classcolumn).Value = classgroup(k) Then GoTo nexti _
    Else classgroup(j) = Cells(i, classcolumn).Value
    If i < lastrow Then j = j + 1
    If i = lastrow Then GoTo done
    GoTo nexti
    Next k
    nexti:
    Next i
    done:
    skip:
    Sheets("Report").Activate
    For l = 1 To j
    Cells(l + 1, 1).Value = classgroup(l)
    Cells(l + 1, 2).Formula = _
    "=sumproduct((classlist=Report!RC[-1])*(itemlist))/sumproduct((classlist=Report!RC[-1])*(itemlist<>""""))"
    Next l
    End Sub

  6. #6
    Registered User
    Join Date
    01-19-2007
    Posts
    4
    This works except I had to change 100 - 10000 because I was getting errors and took a long time to run then. Also when it posts it to the Report sheet its not listing it as unique groups. Its listing all the groups for each class name.

    I need it to list a group only once with its average.

  7. #7
    Valued Forum Contributor
    Join Date
    07-11-2004
    Posts
    851
    I think this works better - sorry about that I did not test other one enough. You may also want to add something to clear the Report sheet before you paste the new info.

    Sub macro1()
    Sheets("Data").Activate
    '100 possible glassgroups
    Dim classgroup(100)
    'header cell of classgroup column named classgroup
    'header cell of itemsordered column named itemsordered
    firstrow = Range("classgroup").Row + 1
    lastrow = Range("classgroup").End(xlDown).Row
    classcolumn = Range("classgroup").Column
    itemcolumn = Range("itemsordered").Column
    Range(Cells(firstrow, itemcolumn), _
    Cells(lastrow, itemcolumn)).Name = "itemlist"
    Range(Cells(firstrow, classcolumn), _
    Cells(lastrow, classcolumn)).Name = "classlist"
    Sheets("Data").Activate
    'read in all unique classgroups
    j = 1
    For i = firstrow To lastrow
    For k = 1 To j
    If Cells(i, classcolumn).Value = classgroup(k) Then GoTo nexti
    Next k
    classgroup(j) = Cells(i, classcolumn).Value
    j = j + 1
    nexti:
    Next i
    done:
    j = j - 1
    Sheets("Report").Activate
    For l = 1 To j
    Cells(l + 1, 1).Value = classgroup(l)
    Cells(l + 1, 2).Formula = _
    "=sumproduct((classlist=Report!RC[-1])*(itemlist))/sumproduct((classlist=Report!RC[-1])*(itemlist<>""""))"
    Next l
    End Sub

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

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

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1