Counting and summing occurrence

[koala]

How do I count up the occurences of non continuous value,

I have a large dataset, that I have to check daily, and need to get two separate results for.

1st requirement.

My data always starts in row 7. The amount of rows is variable, often as high as 50000

In column ?W? are the values ?ON? / ?OFF? or blank.

How can I count up the occurrences the word ?ON? is there, and only count each group of ?ON? as 1 occurrence..

Eg
OFF, ON, OFF, ON, OFF, would count as 2
OFF, ON, ON, OFF, ON, OFF, would also count as 2
OFF, ON, ON, OFF, OFF, ON, ON, OFF, also = 2
OFF, ON, OFF, ON, ON, OFF, ON OFF, would count as 3

Sometimes there will also be empty cells scattered throughout the list as well, these empty cells could be between the ON and wil not end that particular occurence. OFF is the switch between start and end of each occurrence

2nd requirement.

In column ?D? is a timestamp, (row 7 being the earliest, row 8 the next etc.). I need to know the total time that the value in column ?W? was ?ON?.

Eg. The dataset may look like this

D............W
6:17:47 OFF
6:17:49 ON
6:17:50 ON
6:17:52
6:17:53 OFF
6:17:54 OFF
6:17:59 ON
6:18:01
6:18:03 ON
6:18:04 ON
6:18:07 OFF
This would sum 12 Seconds -- 4 seconds on first occurrence, (6:17:49 to 6:17:53) and 8 seconds in the second occurrence (6:17:59 to 6:18:07).

As you can see, an empty cell should not have an impact on the result.

I know this sounds complex, but I am sure someone is able to assist.

Thanks in advance
Koala

[koala]

I am new at vba, so am not sure how to even start this.

In the first instance is it easier maybe to count every occurrence that the OFF goes to ON? and forget about the rest. I think this would give the same result anyway.

If it is ieasier this way could someone please show me how to do it.

cheers
Koala

[Cosmos75]

OK, here my quick attempt at VBA code. It's pretty ugly but hopefully it'll help to get you started...

Option Explicit

Public Sub fCountONSumTIME()
Dim lastRow As Long
    Dim prevW As String
    Dim prevD As Double
    Dim countON As Long
    Dim startTime As Double, _
        endTime As Double, _
        addTime As Double, _
        sumTIME As Double
    Dim r As Long
lastRow = Cells(65536, 23).End(xlUp).Row
prevW = "OFF"
    prevD = 0
    countON = 0
    sumTIME = 0
For r = 7 To lastRow
If (prevW = "OFF") And (Cells(r, 23) = "ON") Then
            countON = countON + 1
            startTime = Cells(r, 4)
        End If
If (r <> 7) And (prevW <> "OFF") And (Cells(r, 23) = "OFF") Then
            endTime = Cells(r, 4)
            addTime = ((endTime - startTime) * 60)
            addTime = (addTime * 60)
            addTime = (addTime * 24)
            sumTIME = sumTIME + addTime
        End If
prevW = Cells(r, 23)
Next r
Debug.Print "countON = " & countON
    Debug.Print "sumTime = " & sumTIME
End Sub

[koala]

Thank you Cosmos75,

This may sound a little silly, but I am new to vba.

I placed your code in a module, ran the macro, it appears to run, but where does it place the result.

I put an active cell at the start of your code, but the result did not go there either?

Could you please assist further

cheers
Koala

[austenr]

Try putting this in place of the Debug.Print.

MsgBox "Count on total " & countON
MsgBox "Sum Time " & sumTIME

[Cosmos75]

Tweaked the code a little but and created a sample

Option Explicit

Public Sub fCountONSumTIME()
Dim lastRow As Long
Dim prevW As String
Dim prevD As Double
Dim countON As Long
Dim startTime As Double, _
endTime As Double, _
addTime As Double, _
sumTIME As Double
Dim r As Long
lastRow = Cells(65536, 23).End(xlUp).Row
prevW = "OFF" 'Set default ON/OFF state to start with
prevD = 0
countON = 0
sumTIME = 0
For r = 7 To lastRow
'Default Cell Formats
Cells(r, 4).Font.Bold = False
Cells(r, 4).Font.Color = vbBlack
Cells(r, 23).Font.Bold = False
Cells(r, 23).Font.Color = vbBlack
If (prevW = "OFF") And (Cells(r, 23) = "ON") Then
countON = countON + 1
startTime = Cells(r, 4)
'Start of ON (Bold RED Font)
Cells(r, 4).Font.Bold = True
Cells(r, 4).Font.Color = vbRed
Cells(r, 23).Font.Bold = True
Cells(r, 23).Font.Color = vbRed
End If
If (r <> 7) And (prevW <> "OFF") And (Cells(r, 23) = "OFF") Then
endTime = Cells(r, 4)
addTime = ((endTime - startTime) * 60 * 60 * 24)
sumTIME = sumTIME + addTime
'End of ON (Bold BLUE Font)
Cells(r, 4).Font.Bold = True
Cells(r, 4).Font.Color = vbBlue
Cells(r, 23).Font.Bold = True
Cells(r, 23).Font.Color = vbBlue
End If
'If current ON/OFF cell is an empty string then
'leave previous ON/OFF state to the last ON/OFF found.
If Not Cells(r, 23) = "" Then prevW = Cells(r, 23)
Next r
MsgBox "countON = " & countON
MsgBox "sumTime = " & sumTIME
'Place count of values in D5 & D6
Range("D5") = countON
Range("D6") = sumTIME
End Sub

Hope that helps!

[Bob Phillips]

OK, here my quick attempt at VBA code. It's pretty ugly but hopefully it'll help to get you started...

An small alternative

Public Sub fCountONSumTIME()
Dim prevW As String
Dim countON As Long
Dim startTime As Double, _
    endTime As Double, _
    sumTIME As Double
Dim r As Long
prevW = "": countON = 0: sumTIME = 0
For r = 7 To Cells(Rows.Count, "D").End(xlUp).Row
        If Cells(r, "W").Value = "ON" Then
            If prevW <> "ON" Then
                countON = countON + 1
                startTime = Cells(r, "D")
                prevW = Cells(r, "W").Value
            End If
        Else
            If Cells(r, "W").Value = "OFF" Then
                If prevW = "ON" Then
                    endTime = Cells(r, "D").Value
                    sumTIME = sumTIME + (endTime - startTime)
                    prevW = Cells(r, "W").Value
                End If
            End If
        End If
    Next r
Debug.Print "countON = " & countON
    Debug.Print "sumTime = " & Format(sumTIME, "hh:mm:ss")
End Sub

[koala]

Cosmos75,

Thank you for taking the time to help me, and I dont wish to impose, however I am a stumped.

Your code works fine on the sample, but for some reason not on the my actual data.

The first problem was I gave you the ON and OFF in UPPER case, when it is actually in Title case, but I am able to fix that.

It is the next problem that has me stumped, so I have included a sample of the actual data, (on sheet 2) and maybe you can advise me where I am going wrong.

It appears the time format is the cause of the problem as I get

Run-Time error, 13 - Type Mismatch,

at the code line:

endTime = Cells(r, 4)

There appears to be some difference in the format, but I can not work it out.

Hoping you are able to assist further

cheers
Koala

[koala]

Sorry XLD, I must have missed your post before.

I just tried your solution and I encounter the same problem as I mentioned above.

It has a mismatch on the line

startTime = Cells(r, "D")

so I really suspect it has something to do with the format of my column "D".

Unfortunately this is the format I get the spreadsheet, and it doesnt seem to change things no matter how I format colum "D"

cheers
Koala

[OBP]

Try

starttime = value(cells(r,"d")) or starttime = value(cells(r,4)) or starttime = (cells(r,"d").value

[sheeeng]

Welcome to VBA Express, koala!
Hope this forum helps you.

[koala]

Thanks OBP,

I have tried all those options, but to no avail.

I even tried to copy column D and then repasting by Paste Special - Values, in case there is something in the format.

That hasnt helped either.

The cells look the same as on sheet 1, but it just wont compute.....

cheers
Koala

[koala]

Thank you all in the forum for helping me with this post.

I have fixed the last problem above, by trimming the contents in column "D" minus 3 (taking out the "Space" "AM"/"PM" at the end), then formating the cells as time. (hh:mm:ss AM/PM).

Not sure why it worked but it does.

cheers
Koala