-1

I have a VBA script that checks a cell if it's named "URL" and outputs results in Row 2, Column 4 & 5.

I would like to alter it so that it checks all cells in column C, and exports it to Column D & E, relative to the cell it just checked.

If it's possible to add a timed delay between each cell execution, that would be great. IE

Execute on Column C, Row 2, print results Wait 1 second Execute on Column C, Row 3, print results Wait 1 second

Etc.

Private Changing As Boolean

Private Sub RedirectChecker(ByVal url As String)
Dim sh As Worksheet
Set sh = ActiveSheet

Dim http As New WinHttp.WinHttpRequest
http.Option(WinHttpRequestOption_UserAgentString) = "Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 6.0)"
http.Option(WinHttpRequestOption_EnableRedirects) = False

'' Clear existing info
sh.Cells(2, 4).Formula = ""
sh.Cells(2, 5).Formula = ""
DoEvents

'' Add protocol if missing
If (InStr(url, "://") = 0) Then
    url = "http://" & url
End If

'' Launch the HTTP request
http.Open "GET", url
If Err.Number <> 0 Then
    '' Handle URL formatting errors
    sh.Cells(2, 4).Formula = Trim(Err.Description)
    Exit Sub
End If
http.Send
If Err.Number <> 0 Then
    '' Handle HTTP errors
    sh.Cells(2, 4).Formula = Trim(Err.Description)
    Exit Sub
End If
'' Show HTTP response info
sh.Cells(2, 4).Formula = http.Status & " " & http.StatusText
sh.Cells(2, 5).Formula = http.GetResponseHeader("Location")
End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
If Changing Then Exit Sub
Changing = True
Dim Name As String
On Error Resume Next
Name = Target.Name.Name
If Name = "URL" Then
    RedirectChecker Target.Value
End If
On Error GoTo 0
Changing = False
End Sub
  • Could you give an example of what you are looking for here. Your question seems bit confusing. – Animesh Sep 29 '16 at 19:24
  • Work Like This: https://s14.postimg.org/ub4tg8jy9/work_like_this.jpg Not Like This: https://s14.postimg.org/7xx2tfj0h/not_that.jpg – alex2k5 Sep 30 '16 at 23:51

1 Answers1

0

you can have the code wait for a second like this:

Application.Wait(Now + TimeValue("00:00:01"))

you just need to integrate that in your loop somewhere, does that answer your question? ps try google: excel vba wait 1 second

code taken from Achaibou Karim post: https://stackoverflow.com/a/23984113/6868389

Community
  • 1
  • 1
lllpratll
  • 368
  • 1
  • 3
  • 8