Restart Code from a certain point

[Sharid]

Could someone please help.

I have two sheet on a workbook

Sheet1 = "Data"
Sheet2 = "URL LIST"

My code process a large amount of urls, this bit works fine. The data is input into sheet1.

Everytime it has proccesed a URL from sheet2 it places a number 1 in Column F on every row of processed url.

If i had 5000 url and i only processed 3596 and then I stopped the code. When I restart it I need it to start from 3595 and not from the begining.

i.e. It will check column F Sheet2 and if there is a Number 1 in it the code will ignore that URL

Problem I have is that it starts from the begining again.

Thanks for haveing a look

 

[Yongle]

Please post your code enclosed in code tags

 

[hotabae]

I don't know your exact situation, but I would do it one of these two ways probably.

1. I'm not sure what you are doing when you "stop" the code, but possibly... could you just "pause" the code and then resume when you are ready?

- If you have "DoEvents" on, you can just click the play/pause buttons at any time.

2. Else, you could use something like this to find the next line:

Dim startNumber as Long

With Sheets("URL LIST")

        If .Cells(1,5).value <> "" and .Cells(2,5).value <> "" Then

                startNumber = .Cells(1,5).End(xlDown).Row + 1

        Else

'THIS IS 1 IF YOUR URLs START IN THE FIRST ROW - ADJUST ACCORDINGLY

                startNumber =1

        End If

End With

For i = startNumber to 5000

'CODE'

Next i

Edit: This assumes Column 'F' is blank before the "1"s are placed.

 

[Fluff]

If col F is blank other than the 1s entered by your code, how about

   Dim i As Long
   With Sheets("URL LIST")
      For i = .Range("F" & Rows.Count).End(xlUp).Row To .Range("A" & Rows.Count).End(xlUp).Row
         'do something
      Next i
   End With

 

[Sharid]

Hi

I could not het either method to work, Not sure what I has doing wrong. This is my full code. The code is stopped as sometimes it becomes frozen and therefore I have to quit. I would like for it to restart from the next row before it stopped

Private Sub CommandButton13_Click()

    Dim LR      As Long
    Dim x       As Long
    Dim arr()   As Variant
      Dim wks     As Worksheet: Set wks = ThisWorkbook.Sheets("URL LIST")
    
    Dim ie      As Object: Set ie = CreateObject("InternetExplorer.Application")
    
Dim dd As Variant
On Error Resume Next
    Application.ScreenUpdating = False
    
    With wks
        LR = .Cells(.Rows.Count, 1).End(xlUp).Row
        .Cells(1, 12).Value = LR
        arr = .Cells(1, 1).Resize(LR).Value
    End With
    
    With ie
        .Visible = True
        Application.Wait Now + TimeValue("0:00:0")
        
        For x = LBound(arr, 1) To UBound(arr, 1)
            .navigate arr(x, 1)
            While .Busy Or .readyState <> 4: DoEvents: Wend
            
            On Error Resume Next
            
  Dim doc As HTMLDocument 'variable for document or data which need to be extracted out of webpage
     Set doc = ie.document
     dd = doc.getElementsByClassName("mbg")(0).Children(0).href
On Error Resume Next

'Paste in this sheet
Sheet1.Cells(Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row + 1, "A").Value = dd
             
            ' Put no1 in sheet2 column F
  Sheets("URL LIST").Range("F" & Rows.Count).End(xlUp).Offset(1, 0).Value = 1
  
 'Deletes duplicates in column A Sheet1
            Columns(1).RemoveDuplicates Columns:=Array(1)
 
 'Count No1 in sheet2 Column F
With Worksheets("URL LIST")
    lastRow = .Cells(.Rows.Count, "F").End(xlUp).Row
    Sheets("URL LIST").Range("L2").Value = lastRow
    End With
             
            Call CommandButton9_Click
        Next x
        .Quit
    End With
   
End Sub

 

[Fluff]

Try

Dim Fr As Long
 With wks
        Fr = .Cells(.Rows.Count, 6).End(xlUp).Offset(1).Row
        Lr = .Cells(.Rows.Count, 1).End(xlUp).Row
        .Cells(1, 12).Value = Lr
        Arr = .Range(.Cells(Fr, 1), .Cells(Lr, 1)).Value
    End With

 

[Sharid]

Fluff

I should have mention when I posted by code, that my coding skills are very limited. The code I posted was 98% forum support and a bit by me. could you tell me were I need to put the bit you just posted

 

[Fluff]

it replaces this

 With wks
        LR = .Cells(.Rows.Count, 1).End(xlUp).Row
        .Cells(1, 12).Value = LR
        arr = .Cells(1, 1).Resize(LR).Value
    End With

 

[Sharid]

sorry spoke too soon, I worked it out. Thanks Fluff

 

[Fluff]

You're welcome