Macro For Re-Coding Variables after a Specified Cut-off

[Darko_Giac]

Hi All,

I currently have a fairly large data set of dichotomized data points denoting a right (1's) and wrong response (0's)

I currently have a custom function that will start summing correct responses, but stop summing after a respondent has received four (or more) 0's in a row

What I am looking to do next is write a macro that will re-code all of the responses after the participant has reached the four-0's-in-a-row cut-off to 0's (even if they got some questions correct after they answered four or more in a row incorrectly).

I've attached a workbook which will hopefully clarify the issue, but any help/advice would be greatly appreciated!

Darko

[p45cal]

This runs on the active sheet:
Sub blah()
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
For Each rw In Range("B2:AY" & LastRow).Rows
ZeroCount = 0
For Each cll In rw.Cells
If cll.Value = 0 Then
ZeroCount = ZeroCount + 1
If ZeroCount = 4 Then
Range(cll.Offset(, 1), rw.Cells(rw.Cells.Count)).Value = 0
Exit For
End If
Else
ZeroCount = 0
End If
Next cll
Next rw
End Sub

[Paul_Hossler]

Option Explicit
Sub FourZeros()
Dim r As Long, c As Long
Dim rData As Range

Application.ScreenUpdating = True

Set rData = ActiveSheet.Cells(1, 1).CurrentRegion

With rData
For r = 2 To .Rows.Count
For c = 2 To .Columns.Count - 4
If Application.WorksheetFunction.Sum(.Cells(r, c).Resize(1, 4)) = 0 Then
Range(.Cells(r, c), .Cells(r, c).End(xlToRight)).Value = 0
Exit For
End If
Next c
Next r
End With

Application.ScreenUpdating = True

End Sub