Ladies and Gentlemen,
I have about 5000 lines of database that needs to be separated into about 80 different sheets based on particular values. Below is the code I have attempting to use "Find" in conjunction with a "for loop". However, it appears that I am unable to output other than the first line of match. You will notice that the code is currently outputting row numbers, it will change once I get this issue resolved. Any advise is greatly appreciated.
I have about 5000 lines of database that needs to be separated into about 80 different sheets based on particular values. Below is the code I have attempting to use "Find" in conjunction with a "for loop". However, it appears that I am unable to output other than the first line of match. You will notice that the code is currently outputting row numbers, it will change once I get this issue resolved. Any advise is greatly appreciated.
Code:
Sub PopAll()
For i = 2 To 83
Call New_Sheet_R2
Sheets(Sheets.Count).Range("H2").Value = "01"
Sheets(Sheets.Count).Range("K2").Value = vlookupall(Sheets("Class").Cells(i, 1).Value, Sheets("ClassService").Range("A2:B151"), 2)
Sheets(Sheets.Count).Range("D4").Value = Sheets("Class").Cells(i, 45).Value
Sheets(Sheets.Count).Range("G4").Value = "ASME B31.3"
Sheets(Sheets.Count).Range("J4").Value = Sheets("Class").Cells(i, 44).Value
Sheets(Sheets.Count).Range("U4").Value = Sheets("Class").Cells(i, 4).Value
Sheets(Sheets.Count).Range("D9").Value = Sheets("Class").Cells(i, 47).Value
For j = 1 To Sheets("Class").Cells(i, 46).Value
Dim searchRange As Range, lastCell As Range, cellFound As Range, firstAddress As String
Dim SearchText As String
SearchText = Sheets("Class").Cells(i, 1).Value
'set the search range
Set searchRange = Sheets("Pipespec").Range("A2:A5305")
'specify last cell in range
Set lastCell = searchRange.Cells(searchRange.Cells.Count)
Set cellFound = searchRange.Find(What:=SearchText, After:=lastCell, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Not cellFound Is Nothing Then
Sheets(Sheets.Count).Cells(j + 14, 4).Value = cellFound.Row
lastCell = cellFound.Address
Sheets(Sheets.Count).Cells(2, 1).Value = cellFound.Address
Else
Sheets(Sheets.Count).Cells(2, 1).Value = "Found Nothing"
End If
Next j
Next i
End Sub