Public Sub Test()
Sheets("REGISTER").Select
Dim Products As Range
Set Products = ActiveSheet.Range("B13:B50")
With Products
Dim FlatFee As String
Do
FlatFee = Products.Find(What:="GSBA95", After:=ActiveCell, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False) 'CODE BREAKS HERE
If FlatFee <> NullString Then ActiveCell.Offset(0, 1).Value = 1
Exit Do
Loop Until Products = ""
Sheets("REGISTER").Select
Dim Products1 As Range
Set Products1 = ActiveSheet.Range("B13:B50")
With Products1
Dim FlatFee1 As String
Do
FlatFee1 = .Columns(1).Find(What:="RT1", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If FlatFee1 <> NullString Then ActiveCell.Offset(0, 1).Value = 1
Exit Do
Loop Until Products1 = ""
Sheets("REGISTER").Select
Dim Products2 As Range
Products2 = ActiveSheet.Range("B13:B50")
With Products2
Dim FlatFee2 As String
Do
FlatFee2 = .Columns(1).Find(What:="RT2", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If FlatFee2 <> NullString Then ActiveCell.Offset(0, 1).Value = 1
Exit Do
Loop Until Products2 = ""
Sheets("REGISTER").Select
Dim Products3 As Range
Products3 = ActiveSheet.Range("B13:B50")
With Products3
Dim FlatFee3 As String
Do
FlatFee3 = .Columns(1).Find(What:="CST1D", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If FlatFee3 <> NullString Then ActiveCell.Offset(0, 1).Value = 1
Exit Do
Loop Until Products3 = ""
.
.
.
.
.
.
Sheets("REGISTER").Select
Dim Products11 As Range
Products11 = ActiveSheet.Range("B13:B50")
With Products11
Dim FlatFee11 As String
Do
FlatFee11 = .Columns(1).Find(What:="CST4M", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If FlatFee11 <> NullString Then ActiveCell.Offset(0, 1).Value = 1
Exit Do
Loop Until Products11 = ""
Sheets("REGISTER").Select
Dim Products12 As Range
Products12 = ActiveSheet.Range("B13:B50")
With Products12
Dim FlatFee12 As String
Do
FlatFee12 = .Columns(1).Find(What:="GSBA100", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If FlatFee12 <> NullString Then ActiveCell.Offset(0, 1).Value = 1
Exit Do
Loop Until Products12 = ""
Sheets("REGISTER").Select
Dim Products13 As Range
Products13 = ActiveSheet.Range("B13:B50")
With Products13
Dim FlatFee13 As String
Do
FlatFee13 = .Columns(1).Find(What:="CCT1D", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If FlatFee13 <> NullString Then ActiveCell.Offset(0, 1).Value = 1
Exit Do
Loop Until Products13 = ""
Sheets("REGISTER").Select
Dim Products14 As Range
Products14 = ActiveSheet.Range("B13:B50")
With Products14
Dim FlatFee14 As String
Do
FlatFee14 = .Columns(1).Find(What:="CCT1M", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:=lPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If FlatFee14 <> NullString Then ActiveCell.Offset(0, 1).Value = 1
Exit Do
Loop Until Products14 = ""
Sheets("REGISTER").Select
Dim Products15 As Range
Products15 = ActiveSheet.Range("B13:B50")
With Products15
Dim FlatFee15 As String
Do
FlatFee15 = .Columns(1).Find(What:="CCT2D", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If FlatFee15 <> NullString Then ActiveCell.Offset(0, 1).Value = 1
Exit Do
Loop Until Products15 = ""
Sheets("REGISTER").Select
Dim Products16 As Range
Products16 = ActiveSheet.Range("B13:B50")
With Products16
Dim FlatFee16 As String
Do
FlatFee16 = .Columns(1).Find(What:="CCT2M", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If FlatFee16 <> NullString Then ActiveCell.Offset(0, 1).Value = 1
Exit Do
Loop Until Products16 = ""
Sheets("REGISTER").Select
Dim Products17 As Range
Products17 = ActiveSheet.Range("B13:B50")
With Products17
Dim FlatFee17 As String
Do
FlatFee17 = .Columns(1).Find(What:="CCT3D", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If FlatFee17 <> NullString Then ActiveCell.Offset(0, 1).Value = 1
Exit Do
Loop Until Products17 = ""
Sheets("REGISTER").Select
Dim Products18 As Range
Products18 = ActiveSheet.Range("B13:B50")
With Products18
Dim FlatFee18 As String
Do
FlatFee18 = .Columns(1).Find(What:="CCT3M", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If FlatFee18 <> NullString Then ActiveCell.Offset(0, 1).Value = 1
Exit Do
Loop Until Products18 = ""
Sheets("REGISTER").Select
Dim Products19 As Range
Products19 = ActiveSheet.Range("B13:B50")
With Products19
Dim FlatFee19 As String
Do
FlatFee19 = .Columns(1).Find(What:="CCT4D", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If FlatFee19 <> NullString Then ActiveCell.Offset(0, 1).Value = 1
Exit Do
Loop Until Products19 = ""
Sheets("REGISTER").Select
Dim Products20 As Range
Products20 = ActiveSheet.Range("B13:B50")
With Products20
Dim FlatFee20 As String
Do
FlatFee20 = .Columns(1).Find(What:="CCT4M", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If FlatFee20 <> NullString Then ActiveCell.Offset(0, 1).Value = 1
Exit Do
Loop Until Products20 = ""
End With
End With
End With
End With
End With
End With
End With
End With
End With
End With
End With
End With
End With
End With
End With
End With
End With
End With
End With
End With
End With
End Sub
Bookmarks