Lookup / Match help ???

[Guest]

Hi,

I have workbook down loaded from a training program and I would like to post
the date under a header for this person if he/she has taken this certian
training. I want to have this in a different workbook but link to the
training download book.
TRAINING DOWNLOAD:
A B C D E F
G
1 SS# JOB# LNAME FNAME TRAINING DATEASS DATECOMP
2 the data for above header names in rows 1-7137
ALL THE DATA IN THIS FORMATE, 7137 ROWS. Each person will be listed many
times but with different training names.

Now on my sheet I want all training names across the top as headers and each
persons SS#, JOB#, LNAME, FNAME down the left side. This way I will only have
each persons name once and would like to show the DATECOMP in the field
beside their name if the training has been completed.
MY SHEET Ex.
A B C D E
F 1 SS# JOB# LNAME
FNAME TRAIN1 TRAIN2
2 000-00-0000 2110 SMITH JOE (DATE IF FOUND) (DATE IF FOUND)
This is what I want my sheet to look like
Question: is there a formula I can write to bring back this date if there is
a completed date beside the presons name that matches the training name and
the persons name or SS# because some have the same names.

 

[Guest]

Can anyone help at all on this? If it is not possible please let me know.
thanks....

 

[Dave Peterson]

As links????

I don't think I'd try it.

But as a macro that you could refresh whenever you needed to, I think this'll
work.
(instead of looping through the input range to populate the output range, I
chose to use a bunch of formulas. It takes sometime to calculate--but I didn't
take the time to see if the first way was faster.)

Option Explicit
Sub testme01()

Dim curWks As Worksheet
Dim newWks As Worksheet
Dim myRng As Range
Dim LastRow As Long
Dim LastCol As Long
Dim iCol As Long
Dim myInputRng As Range
Dim myCell As Range

Application.ScreenUpdating = False

Set curWks = Worksheets("sheet1")
Set newWks = Worksheets.Add

With curWks
Set myInputRng = .Range("a1:G" & .Cells(.Rows.Count, "A").End(xlUp).Row)
Application.StatusBar = "determining training headers"
With myInputRng
.Columns(5).AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=newWks.Range("d1"), Unique:=True
End With
End With

With newWks
With .Range("d:d")
.Cells.Sort Key1:=.Columns(1), Order1:=xlAscending, _
Header:=xlYes
End With
Set myRng = .Range("D2", .Cells(.Rows.Count, "D").End(xlUp))
If myRng.Rows.Count > 250 Then
MsgBox "too many Training classes to fit on the worksheet!"
GoTo ExitNow:
End If
myRng.Copy
.Range("e1").PasteSpecial Transpose:=True
.Range("d:d").Clear
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
End With

With curWks
Application.StatusBar = "Copying SSN's"
With .Range("a:a")
.AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=newWks.Range("a1"), Unique:=True
.Cells.Sort Key1:=.Columns(1), Order1:=xlAscending, _
Header:=xlYes
End With
End With

With newWks
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("e2:E" & LastRow).Formula _
= "=match(a2," _
& curWks.Range("a:a").Address(external:=True) & ",0)"

For iCol = 2 To 4
.Range(.Cells(2, iCol), .Cells(LastRow, iCol)).Formula _
= "=index(" & curWks.Columns(iCol).Address(external:=True) & ",e2)"
Next iCol

With .UsedRange
.Value = .Value
End With

.Range("e2:e" & LastRow).Clear

.Range("a1").Resize(1, 4).Value _
= Array("SS#", "JOB#", "LNAME", "FNAME")

Set myRng = .Range("E2", .Cells(2, LastCol))

Application.StatusBar = "Populating lots of formulas"
For Each myCell In myRng.Cells
With myCell
.FormulaArray _
= "=INDEX(" & myInputRng.Columns(7).Address _
(external:=True, ReferenceStyle:=xlR1C1) & "," _
& "match(1,(" & myInputRng.Columns(1).Address _
(external:=True, ReferenceStyle:=xlR1C1) _
& "=rc1)*(" _
& myInputRng.Columns(5).Address _
(external:=True, ReferenceStyle:=xlR1C1) _
& "=r1c),0))"
End With
Next myCell

Application.StatusBar = "Filling the formulas down"
myRng.AutoFill _
Destination:=myRng.Resize(LastRow - 1)

Application.StatusBar = "Cleaning up"
With myRng.Resize(LastRow - 1)
.Value = .Value
.Replace what:="#n/a", replacement:="", lookat:=xlWhole, _
MatchCase:=False
.NumberFormat = "mm/dd/yyyy"
End With

Application.Goto .Range("a1"), scroll:=True
.Range("e2").Select
ActiveWindow.FreezePanes = True

With .UsedRange
.Columns.AutoFit
End With
End With

ExitNow:
With Application
.ScreenUpdating = True
.StatusBar = False
End With

End Sub

 

[Dave Peterson]

ps...

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

<<snipped>>