VBA - get alphanumeric code using date in column header

[ajm]

Hi again, i am trying to copy a alphanumeric "name" from column A to my source workbook. These names are the usernames of people responsible for particular shifts.

				Tue	Wed	Thu	Fri
Pay No		Shift	Name	1	2	3	4
AX123				D	D	D	D
BO2596				N	N	N	N
F548H				O	O	O	O
85HO				D	D	D	D
5PO9				D	D	D	D

<tbody>
</tbody>

The D, N, & O under each day represent Day, Night, Off. They always start at row 142.

So, for first of October, there are three people on Dayshift, i need to copy these guys to my source workbook column O6,O7,O8, 1 on Nights (copy to Source P6), and 1 with a day off.

My code at present looks like this:

Sub ImportRoster()

    Dim strRosterDate As String, strRosterDay As Long
    Dim wkbRoster As Workbook, wkbSource As Workbook
    Dim fNameRoster As String
    Dim rngDayRost1 As Range, rngDayRost2 As Range, rngDayRost3 As Range
    Dim rngNightRost1 As Range, rngNightRost2 As Range, rngNightRost3 As Range
    Dim rngOffRost1 As Range, rngOffRost2 As Range, rngOffRost3 As Range
    
    
    Set wkbSource = ThisWorkbook
    
    'name the Roster workbook
    fNameRoster = wkbSource.ActiveSheet.Range("O3").Value
    
    ' what month and day do we need
    strRosterDate = Format(wkbSource.ActiveSheet.Range("A1"), "Mmm")
    strRosterDay = Format(wkbSource.ActiveSheet.Range("A1"), "d")
    
    'copy to traget ranges
    Set rngDayRost1 = wkbSource.ActiveSheet.Range("O6")   'Dayshift 1
    Set rngDayRost2 = wkbSource.ActiveSheet.Range("O7")  'Dayshift 2
    Set rngDayRost3 = wkbSource.ActiveSheet.Range("O8")  'Dayshift 3
    Set rngNightRost1 = wkbSource.ActiveSheet.Range("P6")  'Night 1
    Set rngNightRost2 = wkbSource.ActiveSheet.Range("P7")   'night 2
    Set rngNightRost3 = wkbSource.ActiveSheet.Range("P8")    'night 3
    Set rngOffRost1 = wkbSource.ActiveSheet.Range("Q6")   'off 1
    Set rngOffRost2 = wkbSource.ActiveSheet.Range("Q7")    'off 2
    Set rngOffRost3 = wkbSource.ActiveSheet.Range("Q8")    'off 3
    
 
    
    
    'create the file path of roster workbook
    MyPath = wkbSource.ActiveSheet.Range("P1").Value 'no need to add trailing backslash
    
    If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
       
    Myfile = Dir(MyPath & fNameRoster & "*.xls*", vbNormal)
   
    If Len(Myfile) = 0 Then
       MsgBox "No files were found...", vbExclamation
        Exit Sub
    End If
    
    'open roster workbook
    With Workbooks.Open(Myfile)
    
    'which month- already have variable strRosterDate holding MMM - this will identify the sheet in the Roster workbook
    'which day - strRosterDay has which day of the month it is - this ids which column to find
    
   
    
    
        Set rngCopy = .Sheets(strRosterDate).Range(???????????) ' 
        Set rngTarget = SourceWb.Sheets("MLP").Range("A3")


        rngCopy.Copy Destination:=rngTarget
        Application.CutCopyMode = False


    End With
  
    With SourceWb
        Set formulaCopy = .Sheets("MLP").Range("ey1:fb1")
        Set formulaTarget = .Sheets("MLP").Range("ey3:fb" & LastRow)


        formulaCopy.Copy Destination:=formulaTarget
        Application.CutCopyMode = False
    End With


    Workbooks(LatestFile).Close False


    
    
End Sub

the last part of the code is from another macro which copied a range and pasted back to the source workbook so I am just using these as placeholders.

the particular tab, and the particular day, in the Roster workbook are identified by a variables. I thought i could use these like an H lookup. I am thrown by the multiple names for each shift. I think i should be creating an array to hold them but I don't know how.

Can anyone help me over this hump please?

 

[ajm]

**bump**

 

[ajm]

bump

 

[ajm]

solved this one myself. rather than doing lookups and finds and whatnot, i decided to copy the ranges into my source workbook and then use a multi criteria, multi range lookup (thanks to Leila Ghaharani at Xel Plus).