VBA code identify rows that have exceeded a certain value in a cumulative chain

[lgare]

Hi,

I have a data set of around 4000 individuals where each individual has multiple rows pertaining to scores in exams. Each row for each student contains an exam grade, and I have a column displaying the amount of credits the exam is worth (‘Exam Credit’). I need to identify the ‘best’ 100 credits worth of exam results for each student. I have sorted the data so that each students’ exam scores are in highest to lowest order. Can someone suggest some VBA code that will cumulatively add each students’ credit up to 100, then mark any subsequent exam rows with a N/A (or a #N/A or leave blank), as is shown in the ‘Cumulative Credit’ column. Any suggestions much appreciated.

Person Number	Exam Credit	Exam Score	Cumulative Credit
XXXXXX001	20	11	20
XXXXXX001	20	10	40
XXXXXX001	40	8	80
XXXXXX001	20	4	100
XXXXXX001	20	4	N/A
XXXXXX002	20	15	20
XXXXXX002	60	13	80
XXXXXX002	20	7	100
XXXXXX002	20	7	N/A
XXXXXX002	20	6	N/A
XXXXXX003	40	13	40
XXXXXX003	20	13	60
XXXXXX003	40	12	100
XXXXXX003	20	10	N/A
XXXXXX004	20	13	20
XXXXXX004	80	13	100
XXXXXX004	20	9	N/A

<tbody>
</tbody>

 

[MickG]

Try:-

[COLOR="Navy"]Sub[/COLOR] MG17Dec57
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, Temp [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String,[/COLOR] Num [COLOR="Navy"]As[/COLOR] Double
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]If[/COLOR] Not Temp = Dn.Value [COLOR="Navy"]Then[/COLOR] Num = 0
        Num = Num + Dn.Offset(, 1)
        Dn.Offset(, 3).Value = IIf(Num <= 100, Num, "N/A")
    Temp = Dn.Value
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[lgare]

Looks like this has worked perfectly! Thank you very much!

 

[MickG]

You're welcome

 

[hiker95]

MickG,

Nicely done as always.


lgare,

Here is another macro solution for you to consider.

You can change the raw data worksheet name in the macro.

Sample raw data, and, results:

Excel 2007
	A	B	C	D
1	Person Number	Exam Credit	Exam Score	Cumulative Credit
2	XXXXXX001	20	11	20
3	XXXXXX001	20	10	40
4	XXXXXX001	40	8	80
5	XXXXXX001	20	4	100
6	XXXXXX001	20	4	N/A
7	XXXXXX002	20	15	20
8	XXXXXX002	60	13	80
9	XXXXXX002	20	7	100
10	XXXXXX002	20	7	N/A
11	XXXXXX002	20	6	N/A
12	XXXXXX003	40	13	40
13	XXXXXX003	20	13	60
14	XXXXXX003	40	12	100
15	XXXXXX003	20	10	N/A
16	XXXXXX004	20	13	20
17	XXXXXX004	80	13	100
18	XXXXXX004	20	9	N/A
19
Sheet1

Sub UpdateCumulative()
' hiker95, 12/17/2015, ME909358
Dim lr As Long, r As Long, n As Long
Application.ScreenUpdating = False
With Sheets("Sheet1")   '<-- you can change the sheet name here
  lr = .Cells(Rows.Count, 1).End(xlUp).Row
  For r = 2 To lr
    n = Application.CountIf(.Columns(1), .Cells(r, 1).Value)
    If n = 1 Then
      .Cells(r, 4).Value = .Cells(r, 2).Value
    ElseIf n > 1 Then
      With .Cells(r, 4)
        .FormulaR1C1 = "=RC[-2]"
        .Value = .Value
      End With
      With .Range(.Cells(r + 1, 4), .Cells(r + n - 1, 4))
        .FormulaR1C1 = "=IF(R[-1]C>=100,""N/A"",R[-1]C+RC[-2])"
        .Value = .Value
      End With
    End If
    r = r + n - 1
  Next r
End With
Application.ScreenUpdating = True
End Sub