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