Excel based tutorial for web scraping

[mark49]

Yes I think so b_rad, I can pull the data for the NFL season, box scores and line & total for each game, but I have only tried it on 20+ games so far while I work out all the small problems like OT and pick-em games.

I will post the code later if you want to run it yourself and have a look.

I had a similar problem as you with the data beginning further down the sheet because I had put some formulas to the side of the data and the code will only run from the first unused line. I eventually solved it after several attempts at deleting all the data on sheet1 and retyping the headers.

[b_rad_1983]

I'm currently working on the NHL example from the beginning posts. I plan on adding a few things
-Message box
-Headers
-Progress bar

Message box will ask for the year and update the code,
The headers are automatically placed in "sheet1" followed by the data
Progress bar will give a time on how long it will be <- this is tough

[b_rad_1983]

Heres what i think is a default macro for the status bar
I'm thinking of using gamenumber logic to figure out the percentage

kinda stumped... I will keep working on it.


Sub ShowProgressInLoop()
' Show the progress in a loop

Dim rngCel As Range
Dim lCounter AsLong
Dim lTotal AsLong
lTotal = Selection.Cells.Count ' total amount of cells to walk through

' Makes sure that the statusbar is visible.
Application.DisplayStatusBar = True

ForEach rngCel In Selection
' show the progress in the statusbar:
Application.StatusBar = "Processing cell " & rngCel.AddressLocal & _
" " & Format((lCounter / lTotal), "0%")

' do something
' -* Add your code here *-

' update the counter
lCounter = lCounter + 1
Next rngCel


' When your code is finished, reset the statusbar:
Application.StatusBar = False
EndSub

[b_rad_1983]

I was bringing the covers box scores for NHL and it looks like they only keep 1 year

plus there is way too much data on each page, takes forever

[shovde]

this is some good shit! However I'm getting the 1004 run time error when i tried to run the code. I've checked all the variables and they seem fine, so I'm not really sure whats wrong. In the code I changed NHLyear from 11 to 13, but got the same error. When I view the link in browser it looks just fine.

Link error & code where it happens ----> http://imgur.com/rW7CSQr

[b_rad_1983]

that error happens because they cannot find the games. I think because you're trying to search 13, 13 isn't done so its not going to search for the full 1250.
I found the same type of error with 11, it happens twice.

[b_rad_1983]

Im not at a computer to verify.

[b_rad_1983]

if you go to the link in the error message, type it into your browser there should be no box score for that game

[b_rad_1983]

We will need to add something that if it can't find a game to tell us, write something in that row then continue on.

[shovde]

that error happens because they cannot find the games. I think because you're trying to search 13, 13 isn't done so its not going to search for the full 1250.
I found the same type of error with 11, it happens twice.

yeah I assumed thats why, but I get the same error on 11,12,13. I'll work on it again in a few hours. Thanks for the replies!

[oilcountry99]

I have a question for you guys....first of all I apologize for putting this here but I figure you can help. I'm looking for a way to find tomorrows date in column A and delete that row and the 100 rows below it in excel 2010 vba.

The Date example I am looking for is this 3/28/2014 10:10:00 PM (the 10:10:00 PM is here is the game time which is irrelevant to my search) I want to find just the date portion

I would like to use something like today + 1 or something along those lines to specify the date.

I'm trying to pull odds and I get today's and tomorrow's when I do the web query and I'd like to delete tomorrows entrys.

Awesome thread here guys!!!

[b_rad_1983]

shovde I ran this code and it pulls ten games. I will run all the games next.

Public Sub MainCode()
'This is a comment. This sub will have all of our
'main code and will call other subs


'Below are my variables
Dim totalgames As Integer 'i.e. 1230
Dim NHLyear As Integer 'i.e. 12, two digit because the year in NHL's website is only two digits
Dim gamenumber As Integer


Application.ScreenUpdating = False


For NHLyear = 13 To 13


If NHLyear = 12 Then
totalgames = 720 'shortened season!
Else
totalgames = 1230 '2011 and 2013 both were full seasons
End If


For gamenumber = 1 To 10
Call ImportWebpage(gamenumber, NHLyear)
Call PullData
Next


Next


Application.ScreenUpdating = True




End Sub




Public Sub ImportWebpage(game, gameyear)
'this sub only imports the webpage
Dim gamestring As String


Application.DisplayAlerts = False
Sheets("Sheet2").Delete
Application.DisplayAlerts = True
Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = "Sheet2"


If game < 10 Then
gamestring = "000" & game
ElseIf game < 100 Then
gamestring = "00" & game
ElseIf game < 1000 Then
gamestring = "0" & game
Else
gamestring = game
End If


With Sheets("Sheet2").QueryTables.Add(Connect ion:= _
"URL;http://www.nhl.com/ice/boxscore.htm?id=20" & gameyear & "02" & gamestring, Destination:= _
Range("$A$1"))
.Name = ""
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.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


End Sub


Public Sub PullData()
'this sub will pull data from the imported webpage and
'put into a main sheet which will contain all game data
Dim lastrowsheetone As Integer
Dim findmatch As Integer


lastrowsheetone = Sheets("Sheet1").UsedRange.Rows.Count
findmatch = Application.Match("1st", Sheets("Sheet2").Range("B1:B100"), 0)


'away team stats
Sheets("Sheet1").Cells(lastrowsheetone + 1, 2) = Sheets("Sheet2").Cells(findmatch + 1, 1)
Sheets("Sheet1").Cells(lastrowsheetone + 1, 3) = Sheets("Sheet2").Cells(findmatch + 1, 2)
Sheets("Sheet1").Cells(lastrowsheetone + 1, 4) = Sheets("Sheet2").Cells(findmatch + 1, 3)
Sheets("Sheet1").Cells(lastrowsheetone + 1, 5) = Sheets("Sheet2").Cells(findmatch + 1, 4)
If Sheets("Sheet2").Cells(findmatch + 1, 5) = "" Then
Sheets("Sheet1").Cells(lastrowsheetone + 1, 6) = 0
Else
Sheets("Sheet1").Cells(lastrowsheetone + 1, 6) = Sheets("Sheet2").Cells(findmatch + 1, 5)
End If
Sheets("Sheet1").Cells(lastrowsheetone + 1, 7) = Sheets("Sheet2").Cells(findmatch + 1, 7)


'home team stats
Sheets("Sheet1").Cells(lastrowsheetone + 1, 8) = Sheets("Sheet2").Cells(findmatch + 2, 1)
Sheets("Sheet1").Cells(lastrowsheetone + 1, 9) = Sheets("Sheet2").Cells(findmatch + 2, 2)
Sheets("Sheet1").Cells(lastrowsheetone + 1, 10) = Sheets("Sheet2").Cells(findmatch + 2, 3)
Sheets("Sheet1").Cells(lastrowsheetone + 1, 11) = Sheets("Sheet2").Cells(findmatch + 2, 4)
If Sheets("Sheet2").Cells(findmatch + 2, 5) = "" Then
Sheets("Sheet1").Cells(lastrowsheetone + 1, 12) = 0
Else
Sheets("Sheet1").Cells(lastrowsheetone + 1, 12) = Sheets("Sheet2").Cells(findmatch + 2, 5)
End If
Sheets("Sheet1").Cells(lastrowsheetone + 1, 13) = Sheets("Sheet2").Cells(findmatch + 2, 7)






End Sub

[a4u2fear]

I have a question for you guys....first of all I apologize for putting this here but I figure you can help. I'm looking for a way to find tomorrows date in column A and delete that row and the 100 rows below it in excel 2010 vba.

The Date example I am looking for is this 3/28/2014 10:10:00 PM (the 10:10:00 PM is here is the game time which is irrelevant to my search) I want to find just the date portion

I would like to use something like today + 1 or something along those lines to specify the date.

I'm trying to pull odds and I get today's and tomorrow's when I do the web query and I'd like to delete tomorrows entrys.

Awesome thread here guys!!!

oil, I am on travel so I can't post full solution, but you need to do an "instr()" command. Look at prior posts for the code. It searches one string for another, ie your date cell will be searched for " " or space. So you know where the space is you know your date will be prior to the space. The instr command will return an integer of the position of the space. Ie 10 for your above sample. So you can then use the "mid(" command by doing mid(yourcell, 1, 9) where yourcell is the string or cell that had the date data, and the mid will return the string from chars 1 to 9 or in your example, 3/28/2014. Be sure to use a variable instead of 9 in the mid as it will not always be 9 characters when the month is two digits or the day is a single digit

[a4u2fear]

Brad is right, some nhl.com box scores do not exist. You could write commands to do them but from experience the catch errors in VBA do not always 100% work. Out of 1230 games to have a game or two missing is not a big deal and you can fill in the game data by hand

[a4u2fear]

oil, I am on travel so I can't post full solution, but you need to do an "instr()" command. Look at prior posts for the code. It searches one string for another, ie your date cell will be searched for " " or space. So you know where the space is you know your date will be prior to the space. The instr command will return an integer of the position of the space. Ie 10 for your above sample. So you can then use the "mid(" command by doing mid(yourcell, 1, 9) where yourcell is the string or cell that had the date data, and the mid will return the string from chars 1 to 9 or in your example, 3/28/2014. Be sure to use a variable instead of 9 in the mid as it will not always be 9 characters when the month is two digits or the day is a single digit

Should be something like

Celldate=mid(yourcell, 1, instr(...)-1)

instr is position of space so -1 will return data before it

[b_rad_1983]

Ran the full season, it completed 982 lines before i got an error.

Run time error type mismatch

Highlighted line is
findmatch = Application.Match("1st", Sheets("Sheet2").Range("B1:B100"), 0)

I dragged the yellow cursor to the end sub then hit play.

Same error at 1102 lines.

It looks like there is no data in sheet2 for that game. It cannot find "1st".

Date on Sheet2 is todays date.

So it pulled this years games successfully.

[shovde]

weird b_rad. I got the exact same code (tried yours too just to be sure tho). Searched around for a solution, but as I'm not that familiar with all the commands in this code it might take a while to understand what the issue is. Most likely it's not the code itself. I'm using excel 2010 btw, not sure if that's different from what you use.

In the sub ImportWebpage I put on error resume next, just to see what's happening further down. Got a runtime error 13; type mismatch, Line 105 in the sub Pulldata, and it might be caused by the previos error.

[b_rad_1983]

I'm using excel 2013. a4u2fear would know more about versions than me.

The code I pasted was exactly what I used. So lets trouble shoot.

When the error shows up, click debug.

1-Click on Sheet1 and let me know what line its on. Plus the game data.

2-Go back to VBA and tell me which line is yellow. Then, from there, you will see a yellow arrow on the left, drag it down to the first end sub and hit play.

It should roll through the code and either work or give an error. Once it errors, go back to Sheet1 and lets see if it added more lines. Or if it stopped on the same once again.

[a4u2fear]

On error resume next does not always work.

The he type mismatch error is likely easily solvable if you quickly debug as I've shown prior how to do or work with b-rad

[shovde]

First error appears in .Refresh BackgroundQuery:=False (Ln 89). This happens in the first attempt to run through the code using step by step F8. So no data is in Sheet1, and it's on line 1.

Dragging the arrow down to End Sub and pressing play gives a 2nd error on Ln 92.

findmatch = Application.Match("1st", Sheets("Sheet2").Range("B1:B100"), 0)

Which is kindof obvious since in the first error it was unable to open the url and therefor Sub Pulldata can't pull any data.
Again no lines are added in sheet1.

Since the query doesn't run until I run the line .Refresh BackgroundQuery the error can be any place in there. Though I doutbt It's the case since yours is working fine D:

Answers and suggestions I've searched for includes proxy settings, inet connection, etc. Rewriting the url using path, but I'll have to look at it tomorrow


Edit: First thing in the morning a4u2fear!

[oilcountry99]

Should be something like

Celldate=mid(yourcell, 1, instr(...)-1)

instr is position of space so -1 will return data before it

I think the bigger problem will be referencing the day I want as this will be dynamic and the odds will be pulled each day. So I'd like to keep the current day odds and delete the rest. The date seems to be the obvious trigger point or marker for the delete. I'm not really well versed in VBA but I can get myself around with some simple code. I'll look more into what you've provided me to see if I can make sense of it.

Thanks for your help and all your doing here, it's greatly appreciated.

[b_rad_1983]

First error appears in .Refresh BackgroundQuery:=False (Ln 89). This happens in the first attempt to run through the code using step by step F8. So no data is in Sheet1, and it's on line 1.

Dragging the arrow down to End Sub and pressing play gives a 2nd error on Ln 92.

findmatch = Application.Match("1st", Sheets("Sheet2").Range("B1:B100"), 0)

Which is kindof obvious since in the first error it was unable to open the url and therefor Sub Pulldata can't pull any data.
Again no lines are added in sheet1.

Since the query doesn't run until I run the line .Refresh BackgroundQuery the error can be any place in there. Though I doutbt It's the case since yours is working fine D:

Answers and suggestions I've searched for includes proxy settings, inet connection, etc. Rewriting the url using path, but I'll have to look at it tomorrow


Edit: First thing in the morning a4u2fear!

You have Sheet1 and Sheet2 only, correct?
if so,
go to sheet 1 and start by putting in headers from a1 to m1 ( just just put all number 1)

go to vba,

make sure the gamenumber line is like this -> (For gamenumber = 1 To 10)


put your cursor on the line below

'This is a comment. This sub will have all of our
Press play

It should give you 10 games

[b_rad_1983]

I think the bigger problem will be referencing the day I want as this will be dynamic and the odds will be pulled each day. So I'd like to keep the current day odds and delete the rest. The date seems to be the obvious trigger point or marker for the delete. I'm not really well versed in VBA but I can get myself around with some simple code. I'll look more into what you've provided me to see if I can make sense of it.

Thanks for your help and all your doing here, it's greatly appreciated.

Im not really sure what you are trying to do.

Can you post the webpage your trying to get? Maybe we can help you better

[oilcountry99]

"

[b_rad_1983]

All books? or a certain one?

[b_rad_1983]

"

[b_rad_1983]

You will want to only pull in the current dates lines, no matter what time of day.

You will need to use a variable to look for a specific text within the webpage called "CellTextHot" with a date format such as 03/29 4:05 PM

I will be honest and have no idea how to do this lol

I will look into it though.

[oilcountry99]

Lol, thanks for your time B_rad

I'm most concerned with the opening line and pinnacle, but if I can import everything and then delete all but the current day would be the best solution.

[a4u2fear]

back from out of town but may not have a lot of time since I've been away from my family.

Where does everyone stand?

[b_rad_1983]

Oil wants to get lines for only one day.
I think it could be possible how you showed us but in a loop and exit loop once today's date doesn't match.

Shoved, is having problems grabbing games

And I, need more lessons lol

[b_rad_1983]

Im currently working on a sheet to grab the NHL wild card standings page from NHL>COM

I need to simplify how I have this

With Sheets("Temp").QueryTables.Add(Connectio n:= _
"URL;http://www.nhl.com/ice/standings.htm?season=20132014&type=WC#&n avid=nav-stn-conf" & gameyear & "02" & gamestring, Destination:= _
Range("$A$1"))


Public Sub PullData()


Dim lastrowsheetone As Integer
Dim findmatch As Integer




lastrowsheetone = Sheets("Sheet1").UsedRange.Rows.Count
findmatch = Application.Match("Eastern", Sheets("Temp").Range("a1:a600"), 0)




'Headers
Sheets("Sheet1").Cells(lastrowsheetone + 0, 1) = Sheets("Temp").Cells(findmatch + 1, 2) 'Atlantic
Sheets("Sheet1").Cells(lastrowsheetone + 4, 1) = Sheets("Temp").Cells(findmatch + 5, 2) 'Metro
Sheets("Sheet1").Cells(lastrowsheetone + 8, 1) = Sheets("Temp").Cells(findmatch + 9, 2) 'Wild card
Worksheets("Sheet1").Activate
Range("c1").Select
ActiveCell.Value = "Team"
Worksheets("Sheet1").Activate
Range("d1").Select
ActiveCell.Value = "GP"
Worksheets("Sheet1").Activate
Range("e1").Select
ActiveCell.Value = "Points"


'Atlantic
Sheets("Sheet1").Cells(lastrowsheetone + 1, 2) = Sheets("Temp").Cells(findmatch + 2, 1) '1st
Sheets("Sheet1").Cells(lastrowsheetone + 2, 2) = Sheets("Temp").Cells(findmatch + 3, 1) '2nd
Sheets("Sheet1").Cells(lastrowsheetone + 3, 2) = Sheets("Temp").Cells(findmatch + 4, 1) '3rd


Sheets("Sheet1").Cells(lastrowsheetone + 1, 3) = Sheets("Temp").Cells(findmatch + 2, 2) 'Team 1
Sheets("Sheet1").Cells(lastrowsheetone + 2, 3) = Sheets("Temp").Cells(findmatch + 3, 2) 'Team 2
Sheets("Sheet1").Cells(lastrowsheetone + 3, 3) = Sheets("Temp").Cells(findmatch + 4, 2) 'Team 3


Sheets("Sheet1").Cells(lastrowsheetone + 1, 4) = Sheets("Temp").Cells(findmatch + 2, 4) 'Gp
Sheets("Sheet1").Cells(lastrowsheetone + 2, 4) = Sheets("Temp").Cells(findmatch + 3, 4) 'Gp
Sheets("Sheet1").Cells(lastrowsheetone + 3, 4) = Sheets("Temp").Cells(findmatch + 4, 4) 'Gp


Sheets("Sheet1").Cells(lastrowsheetone + 1, 5) = Sheets("Temp").Cells(findmatch + 2, 8) 'Pts
Sheets("Sheet1").Cells(lastrowsheetone + 2, 5) = Sheets("Temp").Cells(findmatch + 3, 8) 'Pts
Sheets("Sheet1").Cells(lastrowsheetone + 3, 5) = Sheets("Temp").Cells(findmatch + 4, 8) 'Pts


'Metro
Sheets("Sheet1").Cells(lastrowsheetone + 5, 2) = Sheets("Temp").Cells(findmatch + 6, 1) '1st
Sheets("Sheet1").Cells(lastrowsheetone + 6, 2) = Sheets("Temp").Cells(findmatch + 7, 1) '2nd
Sheets("Sheet1").Cells(lastrowsheetone + 7, 2) = Sheets("Temp").Cells(findmatch + 8, 1) '3rd


Sheets("Sheet1").Cells(lastrowsheetone + 5, 3) = Sheets("Temp").Cells(findmatch + 6, 2) 'Team 1
Sheets("Sheet1").Cells(lastrowsheetone + 6, 3) = Sheets("Temp").Cells(findmatch + 7, 2) 'Team 2
Sheets("Sheet1").Cells(lastrowsheetone + 7, 3) = Sheets("Temp").Cells(findmatch + 8, 2) 'Team 3


Sheets("Sheet1").Cells(lastrowsheetone + 5, 4) = Sheets("Temp").Cells(findmatch + 6, 4) 'Gp
Sheets("Sheet1").Cells(lastrowsheetone + 6, 4) = Sheets("Temp").Cells(findmatch + 7, 4) 'Gp
Sheets("Sheet1").Cells(lastrowsheetone + 7, 4) = Sheets("Temp").Cells(findmatch + 8, 4) 'Gp


Sheets("Sheet1").Cells(lastrowsheetone + 5, 5) = Sheets("Temp").Cells(findmatch + 6, 8) 'Pts
Sheets("Sheet1").Cells(lastrowsheetone + 6, 5) = Sheets("Temp").Cells(findmatch + 7, 8) 'Pts
Sheets("Sheet1").Cells(lastrowsheetone + 7, 5) = Sheets("Temp").Cells(findmatch + 8, 8) 'Pts


'Wild Card
Sheets("Sheet1").Cells(lastrowsheetone + 9, 2) = Sheets("Temp").Cells(findmatch + 10, 1) '1st
Sheets("Sheet1").Cells(lastrowsheetone + 10, 2) = Sheets("Temp").Cells(findmatch + 11, 1) '2nd
Sheets("Sheet1").Cells(lastrowsheetone + 13, 2) = Sheets("Temp").Cells(findmatch + 14, 1) '3rd
Sheets("Sheet1").Cells(lastrowsheetone + 14, 2) = Sheets("Temp").Cells(findmatch + 15, 1) '4th
Sheets("Sheet1").Cells(lastrowsheetone + 15, 2) = Sheets("Temp").Cells(findmatch + 16, 1) '5th
Sheets("Sheet1").Cells(lastrowsheetone + 16, 2) = Sheets("Temp").Cells(findmatch + 17, 1) '6th


Sheets("Sheet1").Cells(lastrowsheetone + 9, 3) = Sheets("Temp").Cells(findmatch + 10, 2) 'Team 1
Sheets("Sheet1").Cells(lastrowsheetone + 10, 3) = Sheets("Temp").Cells(findmatch + 11, 2) 'Team 2
Sheets("Sheet1").Cells(lastrowsheetone + 13, 3) = Sheets("Temp").Cells(findmatch + 14, 2) 'Team 3
Sheets("Sheet1").Cells(lastrowsheetone + 14, 3) = Sheets("Temp").Cells(findmatch + 15, 2) 'Team 4
Sheets("Sheet1").Cells(lastrowsheetone + 15, 3) = Sheets("Temp").Cells(findmatch + 16, 2) 'Team 5
Sheets("Sheet1").Cells(lastrowsheetone + 16, 3) = Sheets("Temp").Cells(findmatch + 17, 2) 'Team 6


Sheets("Sheet1").Cells(lastrowsheetone + 9, 4) = Sheets("Temp").Cells(findmatch + 10, 4) 'GP
Sheets("Sheet1").Cells(lastrowsheetone + 10, 4) = Sheets("Temp").Cells(findmatch + 11, 4) 'GP
Sheets("Sheet1").Cells(lastrowsheetone + 13, 4) = Sheets("Temp").Cells(findmatch + 14, 4) 'GP
Sheets("Sheet1").Cells(lastrowsheetone + 14, 4) = Sheets("Temp").Cells(findmatch + 15, 4) 'GP
Sheets("Sheet1").Cells(lastrowsheetone + 15, 4) = Sheets("Temp").Cells(findmatch + 16, 4) 'GP
Sheets("Sheet1").Cells(lastrowsheetone + 16, 4) = Sheets("Temp").Cells(findmatch + 17, 4) 'GP


Sheets("Sheet1").Cells(lastrowsheetone + 9, 5) = Sheets("Temp").Cells(findmatch + 10, 8) 'pts
Sheets("Sheet1").Cells(lastrowsheetone + 10, 5) = Sheets("Temp").Cells(findmatch + 11, 8) 'Pts
Sheets("Sheet1").Cells(lastrowsheetone + 13, 5) = Sheets("Temp").Cells(findmatch + 14, 8) 'Pts
Sheets("Sheet1").Cells(lastrowsheetone + 14, 5) = Sheets("Temp").Cells(findmatch + 15, 8) 'pts
Sheets("Sheet1").Cells(lastrowsheetone + 15, 5) = Sheets("Temp").Cells(findmatch + 16, 8) 'pts
Sheets("Sheet1").Cells(lastrowsheetone + 16, 5) = Sheets("Temp").Cells(findmatch + 17, 8) 'pts


'Autofit and Centers Text
Worksheets("Sheet1").Columns("A:z").Auto Fit
Worksheets("Sheet1").Columns("A:z").Hori zontalAlignment = xlCenter

[a4u2fear]

I helped A4K on an issue where importing the SBR MLB scores doubled the score here

http://forum.sbrforum.com/hockey-betting/2207848-anyone-interested-pulling-historical-results-odds-sbr-p2.html

i.e. if the score was 4-1, it would show as 44 and 11. I didn't have a simple fix for this yet, but I posted an answer that will work for now.

Go to the page to check it out.

[a4u2fear]

brad, you need more loops to simplify. You basically have a (4) sets of (3) lines written for each division above. ]

The below is for metro and atlantic parts you posted
You could simplify to

for z=0 to 4 step 4

y=0
for x=1 to 4

if x=3 then
y=1
elseif x=4 then
y=4
end if

Sheets("Sheet1").Cells(lastrowsheetone + 1+z, x+1) = Sheets("Temp").Cells(findmatch + 2+z, x+y) '1st
Sheets("Sheet1").Cells(lastrowsheetone + 2+z, x+1) = Sheets("Temp").Cells(findmatch + 3+z, x+y) '2nd
Sheets("Sheet1").Cells(lastrowsheetone + 3+z, x+1) = Sheets("Temp").Cells(findmatch + 4+z, x+y) '3rd

Next

[a4u2fear]

so for z=0, you will do the atlantic

then z=4 because it stepped 4 and does metro

I did it quick and did not check it, so hopefully it is right, but at least will show you a simpler version

[b_rad_1983]

Thanks buddy!
Even if it doesn't work correctly its another way of doing! It can be tweaked!