count occasions of sickness

hi all,

I need a UDF to help me determine how many occasions of sickness an employee has had. for each week he is sick it's marked as a 1 in my table. the data runs from d2:bb2.

so if my columns looks like

111100000111001000111

the answer would be 4 because he was off sick for 4 weeks the first time then came back and went off sick for another 3 weeks and then back for 2 weeks etc etc

all help appreciated guys. I need to put the answer in cell bc2

thanks again

yes nathansav

Maybe:

Sub Nickyh1984()
Dim x As Long
Dim i As Long
If Range("D2") = 1 Then
    x = 1
Else
    x = 0
End If
For i = 5 To 54
    If Cells(2, i) = 1 And Cells(2, i - 1) = 0 Then
        x = x + 1
    End If
Next i
Cells(2, 55) = x
End Sub

thanks john, have csn I adapt this to loop through all rows with data as there could be anything from 10 to 1000 employees

Try:

Sub Nickyh1984()
Dim x As Long
Dim y As Long
Dim i As Long
For y = 2 To Range("D" & Rows.count).End(3).Row
If Range("D" & y) = 1 Then
    x = 1
Else
    x = 0
End If
For i = 5 To 54
    If Cells(y, i) = 1 And Cells(y, i - 1) = 0 Then
        x = x + 1
    End If
Next i
Cells(y, 55) = x
Next y
End Sub

Hi.. try this.

I have assumed that the employee names were in Column C.. adapt it to suit.

I have used a helper column (column 85) to transpose each row and then replace the zeros with "" and then count the areas..

The helper column gets cleared after it is used.

Check out the attachment.

Private Sub CommandButton1_Click()
    For Each Cell In Range("C2:C" & Range("C" & Rows.Count).End(xlUp).Row)
        x = Cell.Offset(, 1).Resize(, 51).Value
        Cells(1, 85).Resize(50).Value = Application.Transpose(x)
        With Columns(85)
            x = .Replace("0", "")
        End With
        Z = Application.Max(Columns(85).SpecialCells(2).Areas.Count)
        Cell.Offset(, 52).Value = Z
        Columns(85).ClearContents
    Next Cell
End Sub

another option:

Sub Sickness()
Dim zero_rng As Range, result
On Error Resume Next
Set zero_rng = Range("b2:dd2").Find(0, , xlValues, xlWhole)
If zero_rng Is Nothing Then result = 0 Else result = Range("d2:bb2").RowDifferences(zero_rng).Areas.Count
End Sub

thanks apo this works

but im getting an error when the number of occassions is 0

how can I fix this

any help appreciated

Hi..

This will take care of the zero's..

Private Sub CommandButton1_Click()
    Dim x, Z As Long
    For Each Cell In Range("C2:C" & Range("C" & Rows.Count).End(xlUp).Row)
        x = Cell.Offset(, 1).Resize(, 51).Value
        Cells(1, 85).Resize(50).Value = Application.Transpose(x)
        With Columns(85)
            x = .Replace("0", "")
        End With
        On Error Resume Next
        Z = Application.Max(Columns(85).SpecialCells(2).Areas.Count)
        Cell.Offset(, 52).Value = Z: Z = 0
        On Error GoTo 0
        Columns(85).ClearContents
    Next Cell
End Sub

I tried watersev's code as it looked like a nice idea..

I modified it slightly to iterate through all your rows and also needed to set the range to be the last used column cell or it would add 1 to the count (as there may well be a area between last used value and bb)..

Private Sub CommandButton2_Click()
    Dim zero_rng As Range, result, LastCol As Long
    For i = 2 To Range("C" & Rows.Count).End(xlUp).Row
        LastCol = Range("IV" & i).End(xlToLeft).Column
        On Error Resume Next
        Set zero_rng = Range(Cells(i, 2), Cells(i, LastCol)).Find(0, , xlValues, xlWhole)
        If zero_rng Is Nothing Then result = 0 Else result = Range(Cells(i, 4), Cells(i, LastCol)).RowDifferences(zero_rng).Areas.Count
        Cells(i, 55).Value = result: result = 0
        On Error GoTo 0
    Next i
End Sub

Thanks to watersev for this method.. I have never used it before..

Attached is a workbook showing both options.. you will need to clear column BC before running watersevs (if you have already run mine previously)..