# [VBA / Excel] Score expressions and SUM them

Hello,

I would like my code to do the following:

1 | 00:03 | EXPR A
2 | 00:10 | EXPR C
3 | 00:51 | EXPR B
4 | 00:49 | EXPR A
5 | 00:11 | EXPR C
6 | 01:16 | EXPR C
7 | 00:01 | EXPR A

The code should 'score' when e.g. EXPR A is used and
sum the time, which has a link with EXPR A (on same row)

The result, in this case, should be:

EXPR A: 00:53
EXPR B: 00:51
EXPR C: 01:37

In my application many expressions are used, 100 in total.
In expressions an index ( [integer] ) is included, which
perhaps can be used in the code.

Sample expressions:
[20] Button A21 enabled
[33] Machine running
[67] Machine off

I hope it is possible that a piece of code can sum the period
of time of expressions. I hope somebody knows the answer!

Thank you very much in advance!
###### Who is Participating?

RetiredCommented:
I see you've now asked for the results in another sheet. This creates a new one.

Sub DoSum()
Dim rng As Range
Set rng = ActiveSheet.UsedRange
Dim strNames() As String
Dim dtTotals() As Date
Dim rw As Integer
Dim i As Integer
Dim k As Integer
Dim bFound As Boolean
Dim wks As Worksheet
For rw = 1 To rng.Rows.Count
bFound = False
For i = 0 To k - 1
If strNames(i) = rng.Cells(rw, 3) Then
bFound = True
Exit For
End If
Next i
If Not bFound Then
ReDim Preserve strNames(k)
ReDim Preserve dtTotals(k)
strNames(k) = rng.Cells(rw, 3)
k = k + 1
End If
dtTotals(i) = CDate(rng.Cells(rw, 2)) + dtTotals(i)
Next rw
For i = 0 To k - 1
Debug.Print strNames(i), dtTotals(i)
Next i
For i = 0 To k - 1
wks.Cells(i + 1, 1) = strNames(i)
wks.Cells(i + 1, 2) = Format\$(dtTotals(i), "HH:nn")
Next i
End Sub

0

DeveloperCommented:
Hi,
Do you need code?

1. Sort the column that contains expression using Data>Sort... command so you will have:

1    0:03    EXPR A
4    0:49    EXPR A
7    0:01    EXPR A
3    0:51    EXPR B
2    0:10    EXPR C
5    0:11    EXPR C
6    1:16    EXPR C

2. Using Data > Subtotals... command:
At each change in Expression field, use Sum function and add subtotal to Time field.
3. Now using buttons created in the left of your worksheet you can get the result you want.

Thanks
-FA
0

Author Commented:

the length of the excel sheet (amount of rows / data) can vary.

And I want this code to be totally automatic, because I am not going
to use the application myself. The persons who will be using this
application only should press the 'start' button and the code should
present the result in a different Excel Sheet / Page.

Any idea?
0

RetiredCommented:
If you still want the VBA that you requested, this is it.

Sub DoSum()
Dim rng As Range
Set rng = ActiveSheet.UsedRange
Dim strNames() As String
Dim dtTotals() As Date
Dim rw As Integer
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim bFound As Boolean
For rw = 1 To rng.Rows.Count
bFound = False
For i = 0 To k - 1
If strNames(i) = rng.Cells(rw, 3) Then
bFound = True
Exit For
End If
Next i
If Not bFound Then
ReDim Preserve strNames(k)
ReDim Preserve dtTotals(k)
strNames(k) = rng.Cells(rw, 3)
k = k + 1
End If
dtTotals(i) = CDate(rng.Cells(rw, 2)) + dtTotals(i)
Next rw
For i = 0 To k - 1
Debug.Print strNames(i), dtTotals(i)
Next i
End Sub

0

Author Commented:
Whooooooeeei GrahamSkan!

This is quick! This is good! This is exactly what I need!
So few lines of code, so much functionality!

Thank you very much. You really have earned the 500 points!
I owe you one!

Greetings, and thank you again!
0

RetiredCommented:
Thanks. It helps a lot when the question is as lucid as yours is.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.