Counting data

[Guest]

Hi All,

I am working in analysis company and I need help in this regard

B1 Startup
B2 Excess Idle
B3 Excess Idle
B4 Harsh Braking
B5 Speed
B6 Harsh Braking
B7 Speed
B8 Startup
B9 Harsh Braking
B10 Speed
B11 Speed
B12 Harsh Braking
B13 Excess Idle
B14 Ignition Off
I need that count of Excess Idle, Speed & Harsh Braking between startup to
startup, then count same startup to next startup and so on

Thanks & Regards

 

[Guest]

Hassan,

Try this macro. I have assumed B1 will always contain "Startup"
Right click the worksheet view code and paste in:-

Sub categorise()
Dim myRange As Range
LastRow = Cells(Cells.Rows.Count, "B").End(xlUp).Row
Set myRange = Range("B2:B" & LastRow)
For Each c In myRange
c.Select
Select Case c.Value
Case "Excess Idle"
ei = ei + 1
Case "Harsh Braking"
hb = hb + 1
Case "Speed"
s = s + 1
Case "Startup"
ActiveCell.Offset(-1, 1).Value = "Excell idle " & ei
ActiveCell.Offset(-1, 2).Value = "Harsh Braking " & hb
ActiveCell.Offset(-1, 3).Value = "Speed " & s
ei = 0
hb = 0
s = 0
End Select
Next
End Sub

Mike

 

[Guest]

Hi Mike H,

Thanks for help and I am always saying to my friends that Mike H is giving
the answers of every difficult questions and macros, although my macro is not
difficult for you and I hope you will help me in this regards,

I want the count of Excess Idle in H2, Speed in I2 and Harsh Braking in J2,
and delete that rows which are counted and then go on next startup to start
up and so on.

 

[Guest]

Hassan,

That won't work. If I write the values to H2, I2, and J2 they will get
overwritten for each set of data.

Mike

 

[Guest]

Hi Mike,

For 1st startup to 2nd startup that values goes to H2, I2 and J2 and from
2nd Startup to 3rd startup that count goes to H3, I3 & J3 and so on.

Please help me in this regards

 

[Guest]

maybe this:-

Sub categorise()
Dim myRange As Range
myrow = 2
LastRow = Cells(Cells.Rows.Count, "B").End(xlUp).Row
Set myRange = Range("B2:B" & LastRow)
For Each c In myRange
Select Case c.Value
Case "Excess Idle"
ei = ei + 1
Case "Harsh Braking"
hb = hb + 1
Case "Speed"
s = s + 1
Case "Startup"
Range("H" & myrow).Value = "Excess idle " & ei
Range("I" & myrow).Value = "Harsh Braking " & hb
Range("J" & myrow).Value = "Speed " & s
ei = 0
hb = 0
s = 0
myrow = myrow + 1
End Select
Next
Range("B1:B" & LastRow).ClearContents
End Sub

Mike

 

[Guest]

Hi Mike,

May I have your Email address on which i can send you the file then I think
its easy for you to understand what I try to say, because my english skill is
not high.

Thanks

 

[Guest]

Post the file here and then post the link

http://www.savefile.com/

 

[Guest]

Hi Mike,

http://www.savefile.com/files/1049501

Post the file here and then post the link

http://www.savefile.com/

 

[Guest]

Hassan

http://www.savefile.com/files/1049548

Mike

 

[Guest]

Hi Mike,

Have you received the link?
My hotmail address is (e-mail address removed), If it possible to give me help

 

[Don Guillett]

try this

Sub countbetweenvalues()
lr = Cells(Rows.Count, 2).End(xlUp).Row
p1 = Columns(2).Find("Startup").Row
r = 1
Do Until p1 = lr
'MsgBox p1
p2 = Columns(2).Find("Startup", after:=Cells(p1, 2)).Row - 1
'MsgBox p2
'the next 3 are ONE line each
Cells(r, "h") = Application.CountIf(Range(Cells(p1, 2), Cells(p2, 2)),
"Excess Idle")
Cells(r, "i") = Application.CountIf(Range(Cells(p1, 2), Cells(p2, 2)),
"Harsh braking")
Cells(r, "j") = Application.CountIf(Range(Cells(p1, 2), Cells(p2, 2)),
"Speed")
'=COUNTIF(B2:B8,"Harsh braking")
p1 = p2 + 1
r = r + 1
Loop

End Sub

 

[Don Guillett]

I forgot to add that you will need to add "Startup" as the bottom item or
have the macro do it for you.

 

[Don Guillett]

Use this first to trim column B and then use mine modified to add ; to each
countif

Sub TrimALL()
'David McRitchie 2000-07-03 mod 2000-08-16 2005-09-29 join.htm
'-- http://www.mvps.org/dmcritchie/excel/join.htm#trimall
' - Optionally reenable improperly terminated Change Event macros
Application.DisplayAlerts = True
Application.EnableEvents = True 'should be part of Change Event
macro
If Application.Calculation = xlCalculationManual Then
MsgBox "Calculation was OFF will be turned ON upon completion"
End If
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim cell As Range
'Also Treat CHR 0160, as a space (CHR 032)
Columns(2).Select
Selection.Replace What:=Chr(160), Replacement:=Chr(32), _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
'Trim in Excel removes extra internal spaces, VBA does not
On Error Resume Next 'in case no text cells in selection
For Each cell In Intersect(Selection, _
Selection.SpecialCells(xlConstants, xlTextValues))
cell.Value = Application.Trim(cell.Value)
Next cell
On Error GoTo 0
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub