Lookup part of a cell's contents and return value of entire cell

  • Thread starter Thread starter Terri
  • Start date Start date
T

Terri

I have a schedule of 16 teams over 17 weeks. Right now the weeks are in rows
and matches are in columns, i.e.
A B C D E
1 01/31 01 - 02 03 - 04 05 - 06 07 - 08
2 02/07 04 - 01 06 - 03 08 - 08 10 - 07
3 02/14 05 - 14 09 - 02 12 - 04 16 - 13

Therefore, cell B2 states on Feb. 7th, Team 4 plays against Team 1. Since
one cell contains two numbers, is there a formula that will for one of the
two numbers and return the entire cell to another worksheet? So I can pull
all of one Team's schedule onto a separate worksheet and into one column,
putting formula in column B?
A B
1 01/31 03 - 04
2 02/7 06 - 03
3 02/14 03 - 08
4 02/21 10 - 03

Hope this makes sense, and Thanks a Bunch in advance

T
 
Is a macro ok?

This does assume that each team can only play one game per date:

Option Explicit
Sub testme()
Dim CurWks As Worksheet
Dim RptWks As Worksheet
Dim iRow As Long
Dim oRow As Long
Dim FirstRow As Long
Dim LastRow As Long
Dim TotalTeams As Long
Dim tCtr As Long
Dim SchedRng As Range
Dim FoundCell As Range

Set CurWks = Worksheets("sheet1")
Set RptWks = Worksheets.Add

oRow = 0
TotalTeams = 16

With CurWks
FirstRow = 1 'no headers???
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

For tCtr = 1 To TotalTeams
'add some headers
oRow = oRow + 1
With RptWks.Cells(oRow, "A")
.Value = "Team: " & Format(tCtr, "00")
.Font.Bold = True
End With
If oRow > 1 Then
RptWks.Cells(oRow, "A").PageBreak = xlPageBreakManual
End If
For iRow = FirstRow To LastRow
Set SchedRng = .Range(.Cells(iRow, "B"), _
.Cells(iRow, .Columns.Count).End(xlToLeft))
With SchedRng
Set FoundCell = .Cells.Find(what:=Format(tCtr, "00"), _
after:=.Cells(.Cells.Count), _
LookIn:=xlValues, lookat:=xlPart, _
searchorder:=xlByColumns, _
searchdirection:=xlNext, _
MatchCase:=False)
End With
If FoundCell Is Nothing Then
'team isn't on this row, so do nothing
Else
oRow = oRow + 1
RptWks.Cells(oRow, "A").NumberFormat _
= .Cells(iRow, "A").NumberFormat
RptWks.Cells(oRow, "A").Value = .Cells(iRow, "A").Value
RptWks.Cells(oRow, "B").NumberFormat = "@" 'text
RptWks.Cells(oRow, "B").Value = FoundCell.Value
End If
Next iRow
Next tCtr
End With
End Sub


If you're new to macros, you may want to read David McRitchie's intro at:
http://www.mvps.org/dmcritchie/excel/getstarted.htm
 
Back
Top