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

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

D

Dave Peterson

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

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.