VBA download url in column 2 if "yes" in column 9

[JohnDouglas]

hi guys

i've got a macro that will download every url in column 2. but now i only want it to download the url if theres a "yes" in column 9.

here's the start of my code:

'----------------------------------

'Start downloads
    Dim i As Long, url As String, sh As Worksheet, QName
    With Sheets("Main")
        For i = 7 To .Cells(65536, 1).End(xlUp).Row

strFrmFullUrl = .Cells(i, 2).Value

any ideas how to insert a check that will see if "yes" is in column 9 of each row with a url?

thanks

john

 

[Andrew Poulsom]

Is it?

'Start downloads 
    Dim i As Long, url As String, sh As Worksheet, QName 
    With Sheets("Main") 
        For i = 7 To .Cells(65536, 1).End(xlUp).Row 
            If .Cells(i, 9).Value = "yes" Then
                strFrmFullUrl = .Cells(i, 2).Value
            End If

 

[JohnDouglas]

hmm, thanks for the reply, but no that doesn't appear to work. any other sneaky ideas?

 

[Andrew Poulsom]

In what way doesn't it work?

 

[JohnDouglas]

hi andrew

thanks for your help. the macro just downloaded everything.

here's my sheet:

ThreadWatcher Vers3.xls
	A	B	C	D	E	F	G	H	I
1
2
3
4
5
6	Thread	Url	Lastpost	Numberofposts	Numberofpostssincelastrefresh	Numberofpages	Firstpagetodownload	Finalpagetodownload	Download?
7	IM2007trainingthread	http://www.runnersworld.co.uk/forum/forummessages.asp?dt=4&UTN=86378&last=1&V=6&SP=	13/10/0615:55:49PM	3743	1	188	187	188	yes
8	PirateOlyDistance2007	http://www.runnersworld.co.uk/forum/forummessages.asp?dt=4&UTN=91392&last=1&V=6&SP=	17/10/0614:11:22PM	23	4	2	1	2	no
9	PiratesWorldTour2007	http://www.runnersworld.co.uk/forum/forummessages.asp?dt=4&UTN=91360&last=1&V=6&SP=	17/10/0613:20:23PM	12	1	1	1	1	yes
Main

i'll post the code in the next post.

 

[JohnDouglas]

here's teh code - lets hope it fits!

Sub download_watch_list()

With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
Application.DisplayAlerts = False

'----------------------------------
'Delete old downloads
For Each ws In Worksheets
     Select Case ws.Name
         Case "Main", "vlookup", "Threads"
               ' do nothing
         Case Else
         ws.Delete
     End Select
Next ws
'----------------------------------

'************* YOUR CODE IS HERE *************************
'Start downloads
    Dim i As Long, url As String, sh As Worksheet, QName
    With Sheets("Main")
        For i = 7 To .Cells(65536, 1).End(xlUp).Row
            If .Cells(i, 9).Value = "yes" Then
                strFrmFullUrl = .Cells(i, 2).Value
            End If
            
strFrmFullUrl = .Cells(i, 2).Value
'-------------------------------------------------------------------------------------------
'Sort out URL
'strExtractThreadNumber returns the position of "UTN="
intPositionofUTN = InStr(strFrmFullUrl, "UTN=")
strThreadNumber = Mid(strFrmFullUrl, intPositionofUTN + 4, 5) 'NB when thread numbers exceed 99999 then the number should be changed to 6!!

'create complete URL string
strUrlStem = "http://www.runnersworld.co.uk/forum/forummessages.asp?UTN="
strUrlMid = "&URN=12&dt=4&srchdte=0&cp=" ' the bit in the middle!
strUrlSuffix = "&v=6&sp="

'-------------------------------------------------------------------------------------------
'sort out pages to download
Set wsList = Worksheets.Add
intPageStart = .Cells(i, 7).Value
intPageFinish = .Cells(i, 8).Value

For intCnt = intPageStart To intPageFinish
Set wsDownload = Worksheets.Add
         
url = "Url;" & strUrlStem & strThreadNumber & strUrlMid & intCnt & strUrlSuffix
         
            With wsDownload.QueryTables.Add(Connection:=url, Destination:=Range("A1"))
                .WebSelectionType = xlEntirePage
                .Refresh BackgroundQuery:=False
'                If intCnt > 0 Then
'
'                Else
'
'                End If
            End With
            
 '-------------------------------------------------------------------------------------------
'this next line detects if the end of the thread has been reached

'-------------------------------------------------------------------------------------------

wsDownload.Range("a1:z1000").UnMerge
Set rngFind = wsDownload.Range("a1:z10000").Find("E-mail member", LookAt:=xlPart)

If wsDownload.Range("E12") = "Sorry this thread has been deleted, to access the parent section click here" Then GoTo ThreadEndReached
On Error GoTo ThreadEndReached
'Application.StatusBar = "Extracting posts from download ... "
wsDownload.Range(rngFind.Offset(0, -1).Address, rngFind.Offset(1000, 5).Address).Select
On Error GoTo ThreadEndReached
Call Edit_Links ' this macro splits hyperlinks into text and link.
wsDownload.Range(rngFind.Offset(0, -1).Address, rngFind.Offset(1000, 5).Address).Copy
Set rngLast = wsList.Range("b60000").End(xlUp)
Set rngPaste = rngLast.Offset(1, 0)
rngPaste.PasteSpecial xlPasteValues


ThreadEndReached:
wsDownload.Delete

'-------------------------------------------------------------------------------------------
Next
Set rngLast = wsList.Range("b60000").End(xlUp)

wsList.Range("a1") = 1
wsList.Range("a2") = 2
wsList.Range("a1:a2").AutoFill wsList.Range("a1:a" & rngLast.Row)
wsList.Range("a1:i" & rngLast.Row).Sort key1:=wsList.Range("b1")
Set rngLast = wsList.Range("b60000").End(xlUp)
wsList.Range("a10000:a" & rngLast.Row + 1).EntireRow.Delete
wsList.Range("a1:i" & rngLast.Row).Sort key1:=wsList.Range("a1")
Set rngPost = wsList.Range("g1")
intPostCnt = intPageStart * 20 - 19
'MsgBox "this is the value of intcnt " & intPgeCnt
intPgeCnt = intPageStart
txtPstNbr = "Post number " & intPostCnt & " page " & intPgeCnt 'to ensure the first postnumber is shown
counting = 1
'-------------------------------------------------------------------------------------------
Do Until rngPost.Row > 60000

rngPost.Offset(0, -2) = txtPstNbr

counting = counting + 1

intPostCnt = intPostCnt + 1
If counting > 20 Then
counting = 1
intPgeCnt = intPgeCnt + 1
Else
End If
txtPstNbr = "Post number " & intPostCnt & " page " & intPgeCnt
Set rngPost = rngPost.End(xlDown)
Loop

'-------------------------------------------------------------------------------------------
wsList.Range("a1").EntireColumn.Delete
wsList.Range("b1").EntireColumn.Delete
wsList.Range("a1").Select
wsList.Range("a1").EntireRow.Insert
wsList.Range("a1").EntireRow.Insert
wsList.Range("a1").Select

'-------------------------------------------------------------------------------------------

'-------------------------------------------------------------------------------------------
'calling various macros
Call formatting 'formatting the final text
Call clearcontents 'calls the macro clearcontents to clear the cells with print message in them.
Call TurnPosterlinkToPostername 'converts the poster's name shown as link back to just the name of the poster.
Call CountWords ' ensures only 25 words per line
'-------------------------------------------------------------------------------------------
    Range("A5").Select
    Selection.End(xlDown).Select
            
'-------------------------------------------------------------
'Name sheet
        QName = .Cells(i, 1)
        QName = Mid(QName, 1, 8)
        QName = Replace(QName, ":", " ")
        QName = Replace(QName, "\", " ")
        QName = Replace(QName, "/", " ")
        QName = Replace(QName, "?", " ")
        QName = Replace(QName, "[", "(")
        QName = Replace(QName, "]", ")")
        QName = QName & " ..."
        
        wsList.Name = QName
        
        Do
            If Err <> 0 Then
            Err = 0
                i = i + 1
                sh.Name = QName & i 'if threadname already exists then 1,2,3 etc is added to the end
            End If
        Loop While Err <> 0
        On Error GoTo 0
        ActiveSheet.Move After:=Sheets("Threads")
'-------------------------------------------------------------
            


intCnt = intCnt + 1
        Next
    End With
    
    
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
 End With

Application.DisplayAlerts = True
End Sub

 

[JohnDouglas]

I guess a simple way to solve the problem would be to copy the main sheet to a temp sheet. then delete the non "yes" rows from the main sheet. let the main macro do its work. then copy the temp sheet back to the main sheet again.

but i'd quite like ot know how to solve it neatly with vba.

cheers

jd

 

[Norie]

For a start I think you want to remove the 2nd occurence of strFrmFullUrl = .Cells(i, 2).Value here.

For i = 7 To .Cells(65536, 1).End(xlUp).Row
            If .Cells(i, 9).Value = "yes" Then
                strFrmFullUrl = .Cells(i, 2).Value
            End If
           
strFrmFullUrl = .Cells(i, 2).Value

You'll also need to have a think about what happens if the value in column 9 is not yes.

What should the code do when that occurs?

 

[JohnDouglas]

ahhh, yes i just noticed that second instance - i've removed it now. but still no joy.

if column 9 is anythign other than "yes" the macro needs to skip the url in that row.

cheers

jd

 

[Norie]

John

That was just the first thing needed doing.

I didn't fully examine your code, but it could be as simple as enclosing everything in the If End If structure.

By the way why are you incrementing intCount here?

intCnt = intCnt + 1

It should automatically be incremented by the Next statement.