Need to create loop

S

SQUIDD

Well-known Member
Joined
Jan 2, 2009
Messages
2,090
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

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college
Sort by date Sort by votes
S

SQUIDD

Well-known Member
Joined
Jan 2, 2009
Messages
2,090
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
sorry red highlight has not come out, it is on line 5 of the code
 
Upvote 0
S

SQUIDD

Well-known Member
Joined
Jan 2, 2009
Messages
2,090
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
the end of the loop is determined by a blank cell in column A of the red highlighted part.

Dave
 
Upvote 0
S

SQUIDD

Well-known Member
Joined
Jan 2, 2009
Messages
2,090
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
Does anyone know if this is actually possible to do.
 
Upvote 0
S

SQUIDD

Well-known Member
Joined
Jan 2, 2009
Messages
2,090
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
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
S

SQUIDD

Well-known Member
Joined
Jan 2, 2009
Messages
2,090
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
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
G

gecs

Active Member
Joined
Jan 26, 2009
Messages
320
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
S

SQUIDD

Well-known Member
Joined
Jan 2, 2009
Messages
2,090
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
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
You must log in or register to reply here.

Similar threads

A
  • Question
URL in cell used in VBA code to import web data
Replies
8
Views
583
johnnyL
J
A
  • Question
Getting table from a link from a cell value
Replies
0
Views
222
adipat
A
A
  • Question
Table is not downloading to excel
Replies
0
Views
243
adipat
A
T
  • Question
Import Data from Google Sheet char(10) missing
Replies
0
Views
361
tendosai
T
S
  • Question
Macro Button
Replies
1
Views
271
offthelip
O

Forum statistics

Threads
1,191,689
Messages
5,988,031
Members
440,124
Latest member
vincentchu2369

Share this page

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