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
 

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().
sorry red highlight has not come out, it is on line 5 of the code
 
Upvote 0
the end of the loop is determined by a blank cell in column A of the red highlighted part.

Dave
 
Upvote 0
Does anyone know if this is actually possible to do.
 
Upvote 0
Ok I will try a different approach.

What I need is a code that will look at the value in a cell on sheet 1 starting at a1, then do all my other calculations, after that it will copy and paste from sheet 2 a range of data and paste it to sheet 3, the data is 40 rows so whn it returns to paste the 2nd time around it should paste it at a41(so +40)the code will end if sheet 1 column a? has no more data.

Dave
 
Upvote 0
I have been trying to make this myself so this is 1 last try to see if anyone knows the answer, i am about to make myself over 200 different macros as it is the only way i know.

Dave
 
Upvote 0
Continuing this post with the response for your new post on the same subject.
Calling the Macro1 macro you have from another macro and making it run for every not empty cell in column A in sheet NUMBERS will imply adding two parameters in your Macro1 Sub statement:
Sub Macro1(r as Range, i as Long).
Parameter r is a range to be passed from the calling macro and is a reference to the current cell on column A in sheet NUMBERS for which you want Macro1 to run. Passing this as a range implies that the first line in Macro1 saying Range("A1").Select has to be changed with r.Select.

Presuming then that all the data you write in the TRAP 1, TRAP 2 and so on sheets can be overwritten, we reach the "pasting" part of the Macro1 where you need to select the starting cell of the range where you need to paste the data:
Sheets("data").Select
Range("A1").Select

Here you need to compose the address of the range to select using the "A" (name of the column) and the i parameter. The i parameter will be the number of the row of the data in column A from sheet NUMBERS and the Select statement will be something like:
Range("A" & trim(str(40 * (i - 1) + 1))).Select. This will make Macro1 to start writing the data in the data sheet in column A starting with row 1 (for i=1), row 41 (for i=2) and so on.

The calling macro will look like this:
Code:
Sub callmacro()
    Dim r As Range
    Dim n As Long
    n = 1
    Sheets("NUMBERS").Select
    Set r = Range("A1")
    While Not r.Value = ""
        Call Macro1(r, n)
        n = n + 1
        Sheets("NUMBERS").Select
        Set r = Range("A" & Trim(Str(n)))
    Wend
End Sub
 
Last edited:
Upvote 0
Hi gecs

Thankyou for persisting with my problem.
I follow what you are saying and yes you are correct, the data in trap1-6 will be overwritten.
Now my code looks like this.With this I get an error.

compile error
wrong number of arguments or invalid property assignment

call macro1 is highlighted in blue

Code:
Sub callmacro()
    Dim r As Range
    Dim n As Long
    n = 1
    Sheets("NUMBERS").Select
    Set r = Range("A1")
    While Not r.Value = ""
        Call Macro1(r, n)
        n = n + 1
        Sheets("NUMBERS").Select
        Set r = Range("A" & Trim(Str(n)))
    Wend
End Sub
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=" & r.Select, 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("A" & Trim(Str(40 * (i - 1) + 1))).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End With
    End Sub

Any ideas

Dave
 
Upvote 0

Forum statistics

Threads
1,213,486
Messages
6,113,932
Members
448,533
Latest member
thietbibeboiwasaco

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