Help with Macro

[Sudarshan]

Hi All,

I have a very weird request for a code.

I have a sheet which query the web for result. I input a value in cell G2, the web query runs as its on a refresh based on cell value. There are results that are populated in Range H2:N3.

I currently have to manual input the ID, then copy the values in Range G2:N3 and paste it in next sheet.

i would like to ask help of the members for a code, where i can input the ID in Col A of the sheet and run the macro to get a consolidated result.

The web refresh takes about 3-5 sec for some ID otherwise it is about 1-2 sec.

I have also uploaded the file. minus the web query.

TO summarize, it should copy the value from Col A and paste in G2 and copy G2:N3 and do a paste special values & formatting in the next sheet and repeat the process until it finds a blank cell in Col A.

Thanks
Sudi

 

[Sam Mathai Chacko]

This should do it. Tweak as and where necessary.'

Sub SMC()

    Dim lng As Long
    
    With Worksheets("Sheet1")
        For lng = 1 To .Cells(Rows.Count, "A").End(xlUp).Row
            If .Range("A" & lng).Value <> "" Then
                .Range("G2").Value = .Range("A" & lng).Value
                ThisWorkbook.RefreshAll
                .Range("G2:N3").Copy Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp)(2)
            End If
        Next lng
    End With
    
End Sub

 

[Sudarshan]

It works more to my liking. I just want to check if you can help me to do a paste special value & formats.

Another point is .. the copy should happen only after the background refresh of data is complete.

Hope i am not very demanding with my request.

Thanks
Sudi

 

[Smallman]

Hi Sudarshan

I do a bit of work with Web Queries. A trick for new players, what you have to do is have a bit of a break point within the query to allow it to run. A With statement will suffice.

The following will not run through without completing the transfer from your website, it will provide a break and will refresh the query.

Sub testo()
Dim i As Integer
 
    For i = 2 To Sheet2.Range("A" & Rows.Count).End(xlUp).Row
        [g2] = Sheet1.Range("A" & i)
        With Selection.QueryTable
            .Connection = Sheet1.Range("A" & i).Value
            .Refresh
        End With 'Copy Line next
        [G2:N3].Copy Sheet2.Range("A" & Rows.Count).End(xlUp)(2)
    Next i
End Sub

I can provide an example to prove workings. I have assumed what you have in Col A is something like the following;

URL;http://tatts.com/racing/2013/3/2/PR/3

Which is the address being called in the .Connection line.

Take it easy

Smallman

 

[Sudarshan]

Hi Smallman,

The code gives a run time error application defined or object defined error @ the below line
.Connection = Sheet1.Range("A" & i).Value

The value's in sheet1.Range("A") are the parameters of a website.

for example : https://test.com/dvmats/gf/-/ea_location.php?aid=177#. .. the number 177 is what is entered in Col A of sheet 1.

it should read the value from cell A2, wait for refresh and then copy the data from cell G2:N2 and do a paste special value & format in sheet 2 of the workbook and move to the value in cell A3 and this loop continues until you find a blank cell in Col A.

The catch is what should we do for the wait during the refresh, i need the copy to happen only when the refresh is complete.

Sudi

 

[Smallman]

Hi Sudi

My apologies. I took part of a line out in my webquery and it turned out to be important. Doh!!!

.Refresh BackgroundQuery:=False

Here is a file with some test data. You have not provided the URLs you are using so I decided to create my own. I designed a Webquery tool for the Racing Industry and here is a snippet.

Take care

Smallman

 

[Sam Mathai Chacko]

How about adding a workaround like this

Sub SMC()

    Dim lng As Long
   
    With Worksheets("Sheet1")
        For lng = 1 To .Cells(Rows.Count, "A").End(xlUp).Row
            If .Range("A" & lng).Value <> "" Then
                .Range("G2").Value = .Range("A" & lng).Value
                .Range("H2").ClearContents
                ThisWorkbook.RefreshAll
                While IsEmpty(.Range("H2"))
                Wend
                .Range("G2:N3").Copy Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp)(2)
            End If
        Next lng
    End With
   
End Sub

 

[Sudarshan]

Thanks Sam.. The range H2:N2 is having formula's to sum up all values from the table.

Can we try copying the content of the entire query of the table to the next sheet. I can have the formula's to consolidate in the next sheet.

Thanks in advance.
Sudi

 

[Sam Mathai Chacko]

I didn't notice Smallman had already replied. Did you try his suggestion?

By the way, why do you want to copy the content of the entire query table to the next sheet? You could still stick to your original way of summing up values using formula, but instead of using H2 in my above code, you could use another range, where you know the query results (one of the cells that is) will come in. And replace H2 with the address of that cell. That way, we will know that until that cell is empty, the query hasn't refreshed yet.

 

[Sudarshan]

Perfect Sam.. Truely Legendary ..the logic works perfect.. i changed the range to clear and it works smooth..

One last help would be to request for paste special value & format in sheet2 after we copy the range G2:N2.


Thanks, Happy Weekend.

Sudi

 

[Sam Mathai Chacko]

Try this

Sub SMC()

    Dim lng As Long
   
    With Worksheets("Sheet1")
        For lng = 1 To .Cells(Rows.Count, "A").End(xlUp).Row
            If .Range("A" & lng).Value <> "" Then
                .Range("G2").Value = .Range("A" & lng).Value
                .Range("H2").ClearContents
                ThisWorkbook.RefreshAll
                While IsEmpty(.Range("H2"))
                Wend
                Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp)(2).Resize(2,7).Value = .Range("G2:N3").Value
            End If
        Next lng
    End With
   
End Sub

 

[Sudarshan]

Sweet Sam.. I am impressed by your patience. Thanks for bearing with me for so long.

When the server is slow or its a big table , the workbook freezes with not responding .. otherwise it works good for now.

Sudi

 

[Sudarshan]

Hi Sam,

I am having some trouble and need your help.

The code works brilliant when i run it in break mode ( using F8).. But when i run the code it gets hung with a not responding message.

When i try to force close it pops up an error message "System Error &H80010108 (-2147417848)"

Can you please help me on this.

Sudi

 

[Sudarshan]

Hi Sam,

Also it is copying the data twice in sheet2.

Sudi