Copy Values With Lookups

[Bob81773]

I have a small section in a workbook that is used for calculating various statistics for an individual based on other input. Essentially, the results look something like this:

Today's Date
Individual	Stat One	Stat Two	Stat Three
Peter	14	23	2
John	3	21	5
Jim	21	14	15

<tbody>
</tbody>

From this sheet, I'd like to take the results and copy the values to three different sheets that contain many more individuals -- by finding the individual's name and date, then copying the value. One sheet, for the first statistic, looks like this:

Individual	Date1	Date2	Date3	...
Ralph
Peter
Nancy
Ernest
Frank
John
Paul
Simon
Jim
Jean
Rich

<tbody>
</tbody>

Hopefully, I could do this with VBA and, once the calculations are completed in the small section above, just run the code and copy the results so that new calculations could be done for different individuals.
I'm having a little trouble coming up with this VBA routine. Any help would be appreciated. Thanks.

 

[dhancy]

Try something like this:

Sub aaa()
Dim ws1 As Worksheet
Dim wsStat As Worksheet
Dim r As Integer
Dim c As Integer
Dim rStat As Integer
Dim cStat As Integer
Dim dt As String
Dim name As String
Dim wsname As String
r = 3   ' First row in sheet1 to contain a person's name
c = 2   ' Column in Sheet1 containing stat information to read from
Set ws1 = Sheets("Sheet1")
wsname = ws1.Cells(2, c)
Set wsStat = Sheets(wsname)
dt = ws1.Cells(1, 2)
Do While ws1.Cells(r, 1) <> ""
    name = ws1.Cells(r, 1)
    Set x = wsStat.Rows("1:1").Find(dt, LookIn:=xlValues)
    If Not x Is Nothing Then
        cStat = x.Column
        Set x = wsStat.Columns("A:A").Find(name, LookIn:=xlValues)
        If Not x Is Nothing Then
            rStat = x.Row
            wsStat.Cells(rStat, cStat) = ws1.Cells(r, c)
        End If
    End If
    r = r + 1
Loop
            
End Sub

A few notes:

1) Set the value of "C" to the stat column in your first worksheet where you want to copy from (I'm guessing you want to add a loop on this somewhere to go through all the stat columns)
2) Also, I'm having issues with .find on the date value (the second statement starting with "Set x"). .find works great on string values. Just can't seem to get it to work with date values though. That part still needs more research.

 

[dhancy]

Eureka!! Thanks to Joe4, here is the updated code that fixed the "find date" problem. Thank you Joe4!

Sub aaa()
Dim ws1 As Worksheet
Dim wsStat As Worksheet
Dim r As Integer
Dim c As Integer
Dim rStat As Integer
Dim cStat As Integer
Dim dt As String
Dim name As String
Dim wsname As String
r = 3   ' First row in sheet1 to contain a person's name
c = 2   ' Column in Sheet1 containing stat information to read from
Set ws1 = Sheets("Sheet1")
wsname = ws1.Cells(2, c)
Set wsStat = Sheets(wsname)
dt = DateValue(ws1.Cells(1, 2))
Do While ws1.Cells(r, 1) <> ""
    name = ws1.Cells(r, 1)
    Set x = wsStat.Rows("1:1").Find(dt, LookIn:=xlFormulas)
    If Not x Is Nothing Then
        cStat = x.Column
        Set x = wsStat.Columns("A:A").Find(name, LookIn:=xlValues)
        If Not x Is Nothing Then
            rStat = x.Row
            wsStat.Cells(rStat, cStat) = ws1.Cells(r, c)
        End If
    End If
    r = r + 1
Loop
            
End Sub

 

[Bob81773]

This was extremely helpful. Thanks, dhancy and Joe4 for the help and insight. Much appreciated!