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

JohnDouglas

Board Regular
Joined
Jan 5, 2005
Messages
239
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:
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
 

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).

Andrew Poulsom

MrExcel MVP
Joined
Jul 21, 2002
Messages
73,092
Is it?

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 
            If .Cells(i, 9).Value = "yes" Then
                strFrmFullUrl = .Cells(i, 2).Value
            End If
 

JohnDouglas

Board Regular
Joined
Jan 5, 2005
Messages
239
hmm, thanks for the reply, but no that doesn't appear to work. any other sneaky ideas?
 

JohnDouglas

Board Regular
Joined
Jan 5, 2005
Messages
239

ADVERTISEMENT

hi andrew

thanks for your help. the macro just downloaded everything.

here's my sheet:
ThreadWatcher Vers3.xls
ABCDEFGHI
1
2
3
4
5
6ThreadUrlLastpostNumberofpostsNumberofpostssincelastrefreshNumberofpagesFirstpagetodownloadFinalpagetodownloadDownload?
7IM2007trainingthreadhttp://www.runnersworld.co.uk/forum/forummessages.asp?dt=4&UTN=86378&last=1&V=6&SP=13/10/0615:55:49PM37431188187188yes
8PirateOlyDistance2007http://www.runnersworld.co.uk/forum/forummessages.asp?dt=4&UTN=91392&last=1&V=6&SP=17/10/0614:11:22PM234212no
9PiratesWorldTour2007http://www.runnersworld.co.uk/forum/forummessages.asp?dt=4&UTN=91360&last=1&V=6&SP=17/10/0613:20:23PM121111yes
Main


i'll post the code in the next post.
 

JohnDouglas

Board Regular
Joined
Jan 5, 2005
Messages
239
here's teh code - lets hope it fits!

Code:
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

Board Regular
Joined
Jan 5, 2005
Messages
239

ADVERTISEMENT

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

Well-known Member
Joined
Apr 28, 2004
Messages
76,300
Office Version
  1. 365
Platform
  1. Windows
For a start I think you want to remove the 2nd occurence of strFrmFullUrl = .Cells(i, 2).Value here.
Code:
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

Board Regular
Joined
Jan 5, 2005
Messages
239
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

Well-known Member
Joined
Apr 28, 2004
Messages
76,300
Office Version
  1. 365
Platform
  1. Windows
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?
Code:
intCnt = intCnt + 1
It should automatically be incremented by the Next statement.
 

Forum statistics

Threads
1,136,269
Messages
5,674,739
Members
419,524
Latest member
LakshaySethi

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top