Need to create loop

SQUIDD

Well-known Member
Joined
Jan 2, 2009
Messages
2,104
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
Hello Everyone

Has anyone got any idea how to adjust this code.
What I want is a loop.
Highlighted in red near the top is cell a1, this needs to change to a2 then a3 then a4 and so on for as many times as i need it to.
highlighted in blue near to the end of the code is cell a1,this needs to change to a41 then a81 then a121 then a161 and so on(so +40)for as many times as i need it to.
Thankyou in advance and i hope it makes sense.

Dave



Code:
Sub Macro1()
'
' Macro1 Macro
' everything
'
'
Sheets("RACE IMPORT").Select
    Range("A1").Select
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.thedogs.co.uk/resultsRace.aspx?raceID=" & Range("NUMBERS![COLOR=red]$a$1[/COLOR]").Value, Destination _
        :=Range("$A$1"))
        .Name = "resultsRace.aspx?raceID=220401-11"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlOverwriteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = True
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
        End With
Sheets("TRAP 1").Select
    Range("A1").Select
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.thedogs.co.uk/RaceCard.aspx?dogName=" & Range("24DOGS!$u$8").Value, Destination _
        :=Range("$A$1"))
        .Name = "RaceCard.aspx?dogName=Greylag Sam"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlOverwriteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
    Range("b7:Z375").Select
    ActiveWorkbook.Worksheets("TRAP 1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("TRAP 1").Sort.SortFields.Add Key:=Range("Z9:Z156") _
        , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("TRAP 1").Sort
        .SetRange Range("b7:Z375")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Sheets("TRAP 2").Select
    Range("A1").Select
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.thedogs.co.uk/RaceCard.aspx?dogName=" & Range("24DOGS!$u$9").Value, Destination _
        :=Range("$A$1"))
        .Name = "RaceCard.aspx?dogName=Greylag Sam"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlOverwriteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
    Range("b7:Z156").Select
    ActiveWorkbook.Worksheets("TRAP 2").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("TRAP 2").Sort.SortFields.Add Key:=Range("Z9:Z156") _
        , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("TRAP 2").Sort
        .SetRange Range("b7:Z156")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Sheets("TRAP 3").Select
    Range("A1").Select
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.thedogs.co.uk/RaceCard.aspx?dogName=" & Range("24DOGS!$U$10").Value, Destination _
        :=Range("$A$1"))
        .Name = "RaceCard.aspx?dogName=Greylag Sam"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlOverwriteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
    Range("b7:Z156").Select
    ActiveWorkbook.Worksheets("TRAP 3").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("TRAP 3").Sort.SortFields.Add Key:=Range("Z9:Z156") _
        , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("TRAP 3").Sort
        .SetRange Range("b7:Z156")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Sheets("TRAP 4").Select
    Range("A1").Select
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.thedogs.co.uk/RaceCard.aspx?dogName=" & Range("24DOGS!$U$11").Value, Destination _
        :=Range("$A$1"))
        .Name = "RaceCard.aspx?dogName=Greylag Sam"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlOverwriteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
    Range("b7:Z156").Select
    ActiveWorkbook.Worksheets("TRAP 4").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("TRAP 4").Sort.SortFields.Add Key:=Range("Z9:Z156") _
        , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("TRAP 4").Sort
        .SetRange Range("b7:Z156")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Sheets("TRAP 5").Select
    Range("A1").Select
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.thedogs.co.uk/RaceCard.aspx?dogName=" & Range("24DOGS!$U$12").Value, Destination _
        :=Range("$A$1"))
        .Name = "RaceCard.aspx?dogName=Greylag Sam"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlOverwriteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
    Range("b7:Z156").Select
    ActiveWorkbook.Worksheets("TRAP 5").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("TRAP 5").Sort.SortFields.Add Key:=Range("Z9:Z156") _
        , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("TRAP 5").Sort
        .SetRange Range("b7:Z156")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Sheets("TRAP 6").Select
    Range("A1").Select
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.thedogs.co.uk/RaceCard.aspx?dogName=" & Range("24DOGS!$U$13").Value, Destination _
        :=Range("$A$1"))
        .Name = "RaceCard.aspx?dogName=Greylag Sam"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlOverwriteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
    Range("b7:Z156").Select
    ActiveWorkbook.Worksheets("TRAP 6").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("TRAP 6").Sort.SortFields.Add Key:=Range("Z9:Z156") _
        , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("TRAP 6").Sort
        .SetRange Range("b7:Z156")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
        Sheets("values").Select
    Range("A1:I32").Select
    Selection.Copy
    Sheets("data").Select
    Range("[COLOR=blue]A1[/COLOR]").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End With
    End Sub
 
Well, it seems I didn't get it quite right.
In my previous post I wrote you should replace Range("A1").Select with r.Select and I realise ow this is wrong. You made the right correction to your macro related to the r parameter, but you should have preserved the property Value and replace only the reference: Range("A1") with r. So, now the line in your macro reading:

"URL;http://www.thedogs.co.uk/resultsRace.aspx?raceID=" & r.Select, Destination _

should look like this:

"URL;http://www.thedogs.co.uk/resultsRace.aspx?raceID=" & r.Value, Destination _

You're getting that error because you forgot to modify the Sub statement of Macro1. Instead of:

Sub Macro1()

you should write:

Sub Macro1(r as Range, i as Long)

See if it works.
 
Upvote 0

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.
Thankyou gecs

You seemed to be the only 1 that understood what i was trying to do, maybe i was not explaining myself properly.

I have just run 5 numbers in the NUMBERS sheet and it worked perfectly.
You have saved me 10's of hours of work.

Truely amazing, thankyou so much.

Dave
icon7.gif
:biggrin:
 
Upvote 0
You're welcome. I'm glad it's working and I could be of some help. Don't worry, anyone can be a little bit confused sometimes when trying to explain something now and then. I always hope my English will not let me down when writing in this forum, so I know how difficult can be to find the proper explanation ;)
 
Upvote 0

Forum statistics

Threads
1,214,988
Messages
6,122,620
Members
449,092
Latest member
amyap

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
Back
Top