Best VBA process for extracting data

[nbrown6]

Hi all,

Just wondered what the best VBA procedure would be to get the following outcome.

I have a PDF that has a report that contains up to 150,000 serial numbers. Using an online tool, i can extract the data so that it is usable in excel.

I have written a piece of code to loop through and find the serial numbers along with their ID number, ie 1), 2) etc. As the results from the online tool vary, i am using the search function to find the relevant id number, take the value of the cell next to it and paste it in another worksheet in a logical format.

This works perfectly except when i ask it to do more than about 50,000. The code just hangs after a while. Im not surprised as this is quite labour intensive.

Is there a way i can speed this up, or maybe make it less labour intensive?


Sub Extract_batch_report()

Dim x As Long
Dim Line_ID As Range
Dim Target_row As Long
Dim line_num As String
Dim Serial As String
Dim Status As String


x = 1


For x = 1 To 10000


Target_row = Application.WorksheetFunction.CountA(Sheets("Serial_report").Range("A:A"))


line_num = (x & ")")




Set Line_ID = Sheets("Import").Range("A:D").Find(line_num, lookat:=xlWhole)


Serial = Line_ID.Offset(, 1)
Status = Line_ID.Offset(, 2)
Sheets("Serial_report").Range("A1").Offset(Target_row, 0) = Line_ID
Sheets("Serial_report").Range("A1").Offset(Target_row, 1) = Serial
Sheets("Serial_report").Range("A1").Offset(Target_row, 2) = Status


Next




End Sub

[Artik]

Try it this way
Sub Extract_batch_report_1()
Dim x As Long
Dim Line_ID As Range
Dim Target_row As Long
Dim line_num As String
Dim Serial As String
Dim Status As String


Target_row = Application.WorksheetFunction.CountA(Sheets("Serial_report").Range("A:A"))


For x = 1 To 10000


line_num = (x & ")")


Set Line_ID = Sheets("Import").Range("A:D").Find(line_num, lookat:=xlWhole)


If Not Line_ID Is Nothing Then
Serial = Line_ID.Offset(, 1)
Status = Line_ID.Offset(, 2)
Sheets("Serial_report").Range("A1").Offset(Target_row, 0) = Line_ID
Sheets("Serial_report").Range("A1").Offset(Target_row, 1) = Serial
Sheets("Serial_report").Range("A1").Offset(Target_row, 2) = Status


Target_row = Target_row + 1
End If


If x Mod 50 = 0 Then DoEvents


Next x


End Sub
Using DoEvents will allow you to break the loop with Ctrl + Break at any time (with a small delay).

Artik

[jolivanes]

In which sheet and in which column are the serial numbers?
In which sheet and in which column are the IDs?
You search by IDs right? Not serial numbers.
After you find the ID, you want to copy the ID and the 2 values beside it to the next free cell in another sheet, right?
So what you are doing is putting things in order by the looks of it.
If that is true, can you not sort?


If I am out completely, explain exactly what you want with cells/columns/sheets included in the explanation please