Combining Procedures into Loop

[Slim Slender]

I'd like to combine the following three nearly identical procedures
into one that would loop through the three of them.
2010/09, 2010/10, 2010/11 are in A1:A3 on Sheet2 so they could be
referenced rather than hard coded.


Private Sub CountErrorLoans201009()
Dim cell As Range
Dim xCount As Integer
Dim LoanNumber As String
Dim Errors As String

For Each cell In Sheets("Data").Range("LoanNumbers")

If cell.Value = LoanNumber And _
cell.Offset(0, 1).Value = Errors Then GoTo skipcell
LoanNumber = cell.Value
Errors = cell.Offset(0, 1).Value

If cell.Offset(0, 2).Value = "2010/09" And _
cell.Offset(0, 1).Value = "Error" Then
xCount = xCount + 1
End If
skipcell:
Next cell
Sheets("Sheet2").Range("b1").Value = xCount
xCount = 0
End Sub

Private Sub CountErrorLoans201010()
Dim cell As Range
Dim xCount As Integer
Dim LoanNumber As String
Dim Errors As String

For Each cell In Sheets("Data").Range("LoanNumbers")

If cell.Value = LoanNumber And _
cell.Offset(0, 1).Value = Errors Then GoTo skipcell
LoanNumber = cell.Value
Errors = cell.Offset(0, 1).Value

If cell.Offset(0, 2).Value = "2010/10" And _
cell.Offset(0, 1).Value = "Error" Then
xCount = xCount + 1
End If
skipcell:
Next cell
Sheets("Sheet2").Range("b2").Value = xCount
xCount = 0
End Sub

Private Sub CountErrorLoans201011()
Dim cell As Range
Dim xCount As Integer
Dim LoanNumber As String
Dim Errors As String

For Each cell In Sheets("Data").Range("LoanNumbers")

If cell.Value = LoanNumber And _
cell.Offset(0, 1).Value = Errors Then GoTo skipcell
LoanNumber = cell.Value
Errors = cell.Offset(0, 1).Value

If cell.Offset(0, 2).Value = "2010/11" And _
cell.Offset(0, 1).Value = "Error" Then
xCount = xCount + 1
End If
skipcell:
Next cell
Sheets("Sheet2").Range("b3").Value = xCount
xCount = 0
End Sub

 

[Per Jessen]

Look at this:

Private Sub CountError()
Dim cell As Range
Dim xCount As Integer
Dim LoanNumber As String
Dim Errors As String
Dim DateRng As Range
Dim CellDate As Range

With Worksheets("Sheet2")
Set DateRng = .Range("A1", .Range("A1").End(xlDown))
End With

For Each CellDate In DateRng
For Each cell In Sheets("Data").Range("LoanNumbers")
If cell.Value = LoanNumber And cell.Offset(0, 1).Value <>
Errors Then
LoanNumber = cell.Value
Errors = cell.Offset(0, 1).Value
If cell.Offset(0, 2).Value = CellDate.Value And _
cell.Offset(0, 1).Value = "Error" Then
xCount = xCount + 1
End If
End If
Next cell
CellDate.Offset(0, 1) = xCount
xCount = 0
Next
End Sub

Regards,
Per

 

[Slim Slender]

Thank you! Thank you! Nice work.
I had to restore the skipcell thing to make it work right (see below)
but the loop you provided is such a help because while I only gave
three months procedures as my sample, I had had to repeat and modify
that procedure for many, many months. Thanks again.

Private Sub CountLoanswithanError()
Dim cell As Range
Dim xCount As Integer
Dim LoanNumber As String
Dim Errors As String
Dim DateRng As Range
Dim CellDate As Range

With Worksheets("Sheet3")
Set DateRng = .Range("a1", .Range("a1").End(xlDown))
End With

For Each CellDate In DateRng
For Each cell In Sheets("Data").Range("LoanNumbers")

If cell.Value = LoanNumber And _
cell.Offset(0, 5).Value = Errors Then GoTo skipcell
LoanNumber = cell.Value
Errors = cell.Offset(0, 5).Value

If cell.Offset(0, 12).Value = CellDate.Value And _
cell.Offset(0, 5).Value = "Error" Then
xCount = xCount + 1
End If
skipcell:

Next cell
CellDate.Offset(0, 1) = xCount
xCount = 0
Next
End Sub

 

[Per Jessen]

Thanks for the feedback. I am glad that you got i working.

Regards,
Per