I think you may find this approach more helpful - you've expired on the goodwill with me!
Option Explicit
Dim wsSheet As Worksheet
Dim Rng As Range, CellRange As Range
Dim SrchHorse As Long
Dim Sheet1Time As Long, Sheet1Horse As Long, Sheet1Age As Long, Sheet1Weightpounds As Long, Sheet1Penalty As Long, Sheet1WeightRank As Long, Sheet1DSLR As Long, Sheet1FormString As Long, Sheet1PaceString As Long, Sheet1PaceRating As Long
Dim Sheet2Horse As Long, Sheet2Age As Long, Sheet2DSLR As Long, Sheet2RunsBefore As Long, Sheet2WonBefore As Long, Sheet2PlcBefore As Long, Sheet2HACareer As Long
Dim Sheet1LstRw As Long, Sheet1LstCl As Long, Sheet2LstRw As Long, Sheet2LstCl As Long, rw As Long
Sub xample()
'Code written by [EMAIL="info@poweredbyunicorns.com"][email protected][/EMAIL]
Set wsSheet = Nothing
On Error Resume Next
Set wsSheet = ThisWorkbook.Sheets("Sheet1")
On Error GoTo 0
If wsSheet Is Nothing Then
MsgBox "Sheet1 doesnt exist"
End If
Set wsSheet = Nothing
On Error Resume Next
Set wsSheet = ThisWorkbook.Sheets("Sheet2")
On Error GoTo 0
If wsSheet Is Nothing Then
MsgBox "Sheet2 doesnt exist"
End If
'check if Combined sheet exists, if not create it
Set wsSheet = Nothing
On Error Resume Next
Set wsSheet = ThisWorkbook.Sheets("Combined")
On Error GoTo 0
If Not wsSheet Is Nothing Then
Else
ThisWorkbook.Sheets.Add.Name = "Combined"
End If
If ThisWorkbook.Sheets("Combined").AutoFilterMode Then
ThisWorkbook.Sheets("Combined").AutoFilterMode = False
End If
On Error Resume Next
ThisWorkbook.Sheets("Combined").ShowAllData
On Error GoTo 0
ThisWorkbook.Sheets("Combined").Cells.Clear
ThisWorkbook.Sheets("Combined").Cells.Delete
'this bit is setting the range
On Error Resume Next
Set Rng = Range(ThisWorkbook.Sheets("Sheet1").Cells(2, 2), ThisWorkbook.Sheets("Sheet1").Cells(ThisWorkbook.Sheets("Sheet1").UsedRange.Rows.Count, 2))
On Error GoTo 0
'check that the range is something
If Rng Is Nothing Then
MsgBox "There are no boats!"
Exit Sub
End If
'now we know everything is what it should be, create the sheet. This stipulates the headers. You can go for fixed ranges, but this will aloow you to individually adjust
ThisWorkbook.Sheets("Combined").Cells(1, 1) = "Time"
ThisWorkbook.Sheets("Combined").Cells(1, 2) = "Horse"
ThisWorkbook.Sheets("Combined").Cells(1, 3) = "Age"
ThisWorkbook.Sheets("Combined").Cells(1, 4) = "Weight (pounds)"
ThisWorkbook.Sheets("Combined").Cells(1, 5) = "Penalty"
ThisWorkbook.Sheets("Combined").Cells(1, 6) = "Weight Rank"
ThisWorkbook.Sheets("Combined").Cells(1, 7) = "DSLR"
ThisWorkbook.Sheets("Combined").Cells(1, 8) = "Form String"
ThisWorkbook.Sheets("Combined").Cells(1, 9) = "Pace String"
ThisWorkbook.Sheets("Combined").Cells(1, 10) = "Pace Rating"
ThisWorkbook.Sheets("Combined").Cells(1, 11) = "Horse"
ThisWorkbook.Sheets("Combined").Cells(1, 12) = "Age "
ThisWorkbook.Sheets("Combined").Cells(1, 13) = "DSLR"
ThisWorkbook.Sheets("Combined").Cells(1, 14) = "Runs Before"
ThisWorkbook.Sheets("Combined").Cells(1, 15) = "Won Before"
ThisWorkbook.Sheets("Combined").Cells(1, 16) = "Plc Before"
ThisWorkbook.Sheets("Combined").Cells(1, 17) = "HA Career"
'these are all the variables
Sheet1LstRw = ThisWorkbook.Sheets("Sheet1").UsedRange.Rows.Count
Sheet1LstCl = ThisWorkbook.Sheets("Sheet1").UsedRange.Columns.Count
Sheet2LstRw = ThisWorkbook.Sheets("Sheet2").UsedRange.Rows.Count
Sheet2LstCl = ThisWorkbook.Sheets("Sheet2").UsedRange.Columns.Count
Sheet1Time = 0
On Error Resume Next
Sheet1Time = Application.Match("Time", Range(ThisWorkbook.Sheets("Sheet1").Cells(1, 1), ThisWorkbook.Sheets("Sheet1").Cells(1, Sheet1LstCl)), 0)
On Error GoTo 0
If Sheet1Time = "0" Then
MsgBox "I cannot find Time in the first row on sheet1"
End
End If
Sheet1Horse = 0
On Error Resume Next
Sheet1Horse = Application.Match("Horse", Range(ThisWorkbook.Sheets("Sheet1").Cells(1, 1), ThisWorkbook.Sheets("Sheet1").Cells(1, Sheet1LstCl)), 0)
On Error GoTo 0
If Sheet1Horse = "0" Then
MsgBox "I cannot find Horse in the first row on sheet1"
End
End If
Sheet1Age = 0
On Error Resume Next
Sheet1Age = Application.Match("Age", Range(ThisWorkbook.Sheets("Sheet1").Cells(1, 1), ThisWorkbook.Sheets("Sheet1").Cells(1, Sheet1LstCl)), 0)
On Error GoTo 0
If Sheet1Age = "0" Then
MsgBox "I cannot find Age in the first row on sheet1"
End
End If
Sheet1Weightpounds = 0
On Error Resume Next
Sheet1Weightpounds = Application.Match("Weight (pounds)", Range(ThisWorkbook.Sheets("Sheet1").Cells(1, 1), ThisWorkbook.Sheets("Sheet1").Cells(1, Sheet1LstCl)), 0)
On Error GoTo 0
If Sheet1Weightpounds = "0" Then
MsgBox "I cannot find Age in the first row on sheet1"
End
End If
Sheet1Penalty = 0
On Error Resume Next
Sheet1Penalty = Application.Match("Penalty", Range(ThisWorkbook.Sheets("Sheet1").Cells(1, 1), ThisWorkbook.Sheets("Sheet1").Cells(1, Sheet1LstCl)), 0)
On Error GoTo 0
If Sheet1Penalty = "0" Then
MsgBox "I cannot find Penalty in the first row on sheet1"
End
End If
Sheet1WeightRank = 0
On Error Resume Next
Sheet1WeightRank = Application.Match("Weight Rank", Range(ThisWorkbook.Sheets("Sheet1").Cells(1, 1), ThisWorkbook.Sheets("Sheet1").Cells(1, Sheet1LstCl)), 0)
On Error GoTo 0
If Sheet1WeightRank = "0" Then
MsgBox "I cannot find Age in the first row on sheet1"
End
End If
Sheet1DSLR = 0
On Error Resume Next
Sheet1DSLR = Application.Match("DSLR", Range(ThisWorkbook.Sheets("Sheet1").Cells(1, 1), ThisWorkbook.Sheets("Sheet1").Cells(1, Sheet1LstCl)), 0)
On Error GoTo 0
If Sheet1DSLR = "0" Then
MsgBox "I cannot find DSLR in the first row on sheet1"
End
End If
Sheet1FormString = 0
On Error Resume Next
Sheet1FormString = Application.Match("Form String", Range(ThisWorkbook.Sheets("Sheet1").Cells(1, 1), ThisWorkbook.Sheets("Sheet1").Cells(1, Sheet1LstCl)), 0)
On Error GoTo 0
If Sheet1FormString = "0" Then
MsgBox "I cannot find Form String in the first row on sheet1"
End
End If
Sheet1PaceString = 0
On Error Resume Next
Sheet1PaceString = Application.Match("Pace String", Range(ThisWorkbook.Sheets("Sheet1").Cells(1, 1), ThisWorkbook.Sheets("Sheet1").Cells(1, Sheet1LstCl)), 0)
On Error GoTo 0
If Sheet1PaceString = "0" Then
MsgBox "I cannot find Pace String in the first row on sheet1"
End
End If
Sheet1Weightpounds = 0
On Error Resume Next
Sheet1Weightpounds = Application.Match("Weight (pounds)", Range(ThisWorkbook.Sheets("Sheet1").Cells(1, 1), ThisWorkbook.Sheets("Sheet1").Cells(1, Sheet1LstCl)), 0)
On Error GoTo 0
If Sheet1Weightpounds = "0" Then
MsgBox "I cannot find Weight (pounds) in the first row on sheet1"
End
End If
Sheet1PaceRating = 0
On Error Resume Next
Sheet1PaceRating = Application.Match("Pace Rating", Range(ThisWorkbook.Sheets("Sheet1").Cells(1, 1), ThisWorkbook.Sheets("Sheet1").Cells(1, Sheet1LstCl)), 0)
On Error GoTo 0
If Sheet1PaceRating = "0" Then
MsgBox "I cannot find Pace Rating in the first row on sheet1"
End
End If
Sheet2Horse = 0
On Error Resume Next
Sheet2Horse = Application.Match("Horse", Range(ThisWorkbook.Sheets("Sheet2").Cells(1, 1), ThisWorkbook.Sheets("Sheet2").Cells(1, Sheet2LstCl)), 0)
On Error GoTo 0
If Sheet2Horse = "0" Then
MsgBox "I cannot find Horse in the first row on sheet2"
End
End If
Sheet2Age = 0
On Error Resume Next
Sheet2Age = Application.Match("Age", Range(ThisWorkbook.Sheets("Sheet2").Cells(1, 1), ThisWorkbook.Sheets("Sheet2").Cells(1, Sheet2LstCl)), 0)
On Error GoTo 0
If Sheet2Age = "0" Then
MsgBox "I cannot find Age in the first row on sheet2"
End
End If
Sheet2DSLR = 0
On Error Resume Next
Sheet2DSLR = Application.Match("DSLR", Range(ThisWorkbook.Sheets("Sheet2").Cells(1, 1), ThisWorkbook.Sheets("Sheet2").Cells(1, Sheet2LstCl)), 0)
On Error GoTo 0
If Sheet2DSLR = "0" Then
MsgBox "I cannot find DSLR in the first row on sheet2"
End
End If
Sheet2RunsBefore = 0
On Error Resume Next
Sheet2RunsBefore = Application.Match("Runs Before", Range(ThisWorkbook.Sheets("Sheet2").Cells(1, 1), ThisWorkbook.Sheets("Sheet2").Cells(1, Sheet2LstCl)), 0)
On Error GoTo 0
If Sheet2RunsBefore = "0" Then
MsgBox "I cannot find Runs Before in the first row on sheet2"
End
End If
Sheet2PlcBefore = 0
On Error Resume Next
Sheet2PlcBefore = Application.Match("Plc Before", Range(ThisWorkbook.Sheets("Sheet2").Cells(1, 1), ThisWorkbook.Sheets("Sheet2").Cells(1, Sheet2LstCl)), 0)
On Error GoTo 0
If Sheet2PlcBefore = "0" Then
MsgBox "I cannot find Plc Before in the first row on sheet2"
End
End If
Sheet2WonBefore = 0
On Error Resume Next
Sheet2WonBefore = Application.Match("Won Before", Range(ThisWorkbook.Sheets("Sheet2").Cells(1, 1), ThisWorkbook.Sheets("Sheet2").Cells(1, Sheet2LstCl)), 0)
On Error GoTo 0
If Sheet2WonBefore = "0" Then
MsgBox "I cannot find Won Before in the first row on sheet2"
End
End If
Sheet2HACareer = 0
On Error Resume Next
Sheet2HACareer = Application.Match("HA Career", Range(ThisWorkbook.Sheets("Sheet2").Cells(1, 1), ThisWorkbook.Sheets("Sheet2").Cells(1, Sheet2LstCl)), 0)
On Error GoTo 0
If Sheet2HACareer = "0" Then
MsgBox "I cannot find HA Career in the first row on sheet2"
End
End If
'you know everything exists, so now build your report
'Set the start rw as 2
rw = 2
For Each CellRange In Rng
SrchHorse = 0
On Error Resume Next
SrchHorse = Application.Match(ThisWorkbook.Sheets("Sheet1").Cells(CellRange.Row, Sheet1Horse), Range(ThisWorkbook.Sheets("Sheet2").Cells(1, Sheet2Horse), ThisWorkbook.Sheets("Sheet2").Cells(Sheet2LstRw, Sheet2Horse)), 0)
On Error GoTo 0
If SrchHorse = "0" Then
'it doesn't exist so what should you do
Else
'its found
ThisWorkbook.Sheets("Combined").Cells(rw, 1).Value = ThisWorkbook.Sheets("Sheet1").Cells(CellRange.Row, Sheet1Time).Value
ThisWorkbook.Sheets("Combined").Cells(rw, 2).Value = ThisWorkbook.Sheets("Sheet1").Cells(CellRange.Row, Sheet1Horse).Value
ThisWorkbook.Sheets("Combined").Cells(rw, 3).Value = ThisWorkbook.Sheets("Sheet1").Cells(CellRange.Row, Sheet1Age).Value
ThisWorkbook.Sheets("Combined").Cells(rw, 4).Value = ThisWorkbook.Sheets("Sheet1").Cells(CellRange.Row, Sheet1Weightpounds).Value
ThisWorkbook.Sheets("Combined").Cells(rw, 5).Value = ThisWorkbook.Sheets("Sheet1").Cells(CellRange.Row, Sheet1Penalty).Value
ThisWorkbook.Sheets("Combined").Cells(rw, 6).Value = ThisWorkbook.Sheets("Sheet1").Cells(CellRange.Row, Sheet1WeightRank).Value
ThisWorkbook.Sheets("Combined").Cells(rw, 7).Value = ThisWorkbook.Sheets("Sheet1").Cells(CellRange.Row, Sheet1DSLR).Value
ThisWorkbook.Sheets("Combined").Cells(rw, 8).Value = ThisWorkbook.Sheets("Sheet1").Cells(CellRange.Row, Sheet1FormString).Value
ThisWorkbook.Sheets("Combined").Cells(rw, 9).Value = ThisWorkbook.Sheets("Sheet1").Cells(CellRange.Row, Sheet1PaceString).Value
ThisWorkbook.Sheets("Combined").Cells(rw, 10).Value = ThisWorkbook.Sheets("Sheet1").Cells(CellRange.Row, Sheet1PaceRating).Value
ThisWorkbook.Sheets("Combined").Cells(rw, 11).Value = ThisWorkbook.Sheets("Sheet2").Cells(CellRange.Row, Sheet2Horse).Value
ThisWorkbook.Sheets("Combined").Cells(rw, 12).Value = ThisWorkbook.Sheets("Sheet1").Cells(CellRange.Row, Sheet2Age).Value
ThisWorkbook.Sheets("Combined").Cells(rw, 13).Value = ThisWorkbook.Sheets("Sheet1").Cells(CellRange.Row, Sheet2DSLR).Value
ThisWorkbook.Sheets("Combined").Cells(rw, 14).Value = ThisWorkbook.Sheets("Sheet1").Cells(CellRange.Row, Sheet2RunsBefore).Value
ThisWorkbook.Sheets("Combined").Cells(rw, 15).Value = ThisWorkbook.Sheets("Sheet1").Cells(CellRange.Row, Sheet2WonBefore).Value
ThisWorkbook.Sheets("Combined").Cells(rw, 16).Value = ThisWorkbook.Sheets("Sheet1").Cells(CellRange.Row, Sheet2PlcBefore).Value
ThisWorkbook.Sheets("Combined").Cells(rw, 17).Value = ThisWorkbook.Sheets("Sheet1").Cells(CellRange.Row, Sheet2HACareer).Value
'need to offset for the next row
rw = rw + 1
End If
'next cell in your range
Next CellRange
'tidy the formats
ThisWorkbook.Sheets("Combined").Columns(1).NumberFormat = "hh:mm:ss"
End Sub
Display More