vba for vlookup to paste info onto next line down in next open cell in new workbook

[Saoirse]

Trying to copy with a vlookup info from the list from workbook "Shrinkage" sheet "Friday" then paste it onto workbook "Productivity tracker" sheet "Allie" on the next row down in columns Y:AD.

here afre the macros i keep trying but neither one seems to pull the info the paste onto the "Allie" spreadsheet on the next line down starting on column Y.
Sub shrinkpull()

Dim NextRow As Integer

NextRow = sheets("Allie").Cells(Rows.Count, 23).End(xlUp).Row + 1

sheets("Allie").Range("Y" & NextRow) = Workbooks("Shrinkage.xlsx").Worksheets("Monday").Range("C4:H4").copy _
("Productivity Tracker.xlsm").Worksheets("Allie").Range("Y & NextRow")

End Sub
Sub vlook()
'
Dim NextRow As Integer

NextRow = sheets("Allie").Cells(Rows.Count, 23).End(xlUp).Row + 1
'
Sheets("Allie").Range("Y" & NextRow)= WorksheetFunction.VLOOKUP([Shrinkage.xlsm](sheets("Friday").Range ("A4"),[Shrinkage.xlsm]sheets("Friday").Range("A3:H32"), 3,FALSE))


End Sub

Shrinkage.xlsm
	A		C	D	E	F	G	H
1	Enter the minutes worked for each category. EX: 1 hour = 60; 2 hours = 120		Compliance	System issues	Frontier	Letters / Special projects	Call pulls, fee calculations, large cases	buzz, trianing, coaching
2
3	Alexis
4	Allie		60	10	80	45	20	30
5	Aaron
6	Breonna
Friday

Productivity Tracker.xlsm
	A	B	C	D					I	J			M	N					S	T	U	V	W	X	Y	Z	AA	AB	AC	AD
2	Date	Adjustments made	Prep Cases Worked	Time					Denial Closures	Time			ACE	Time					Approved Closure	Time	Worldpay Settlements	Time	Total Minutes Worked	% time working cases	Compliance	System issues	Frontier	Letters / Special Projects	Call pulls / fee calculations / large cases	buzz, trianing, coaching
3	2/1/2022	46	27	216					1	7				0					11	44	7	21	288	64%	60	10	80	45	20	30
4	2/2/2022	36	11	88					5	35			5	15					2	8	13	39	185	41%
5	2/3/2022	48	2	16					16	112			1	3					17	68	9	27	226	47%
6	2/6/2022	18	2	16					3	21				0					10	40	3	9	86	18%
Allie

Cell Formulas
Range	Formula
W3:W6	W3	=SUM(D3+J3+N3+T3+V3)
X3:X4	X3	=W3/450
Y3	Y3	=VLOOKUP('Z:\Departmental Shares\dOps\POC Training Material\Intake\Lesli Johnson\[Shrinkage.xlsm]Friday'!$A$4,'Z:\Departmental Shares\dOps\POC Training Material\Intake\Lesli Johnson\[Shrinkage.xlsm]Friday'!A$3:H$32,3,FALSE)
Z3	Z3	=VLOOKUP('Z:\Departmental Shares\dOps\POC Training Material\Intake\Lesli Johnson\[Shrinkage.xlsm]Friday'!$A$4,'Z:\Departmental Shares\dOps\POC Training Material\Intake\Lesli Johnson\[Shrinkage.xlsm]Friday'!A$2:H$32,4,FALSE)
AA3	AA3	=VLOOKUP('Z:\Departmental Shares\dOps\POC Training Material\Intake\Lesli Johnson\[Shrinkage.xlsm]Friday'!$A$4,'Z:\Departmental Shares\dOps\POC Training Material\Intake\Lesli Johnson\[Shrinkage.xlsm]Friday'!A$3:H$32,5,FALSE)
AB3	AB3	=VLOOKUP('Z:\Departmental Shares\dOps\POC Training Material\Intake\Lesli Johnson\[Shrinkage.xlsm]Friday'!$A$4,'Z:\Departmental Shares\dOps\POC Training Material\Intake\Lesli Johnson\[Shrinkage.xlsm]Friday'!A$3:H$32,6,FALSE)
AC3	AC3	=VLOOKUP('Z:\Departmental Shares\dOps\POC Training Material\Intake\Lesli Johnson\[Shrinkage.xlsm]Friday'!$A$4,'Z:\Departmental Shares\dOps\POC Training Material\Intake\Lesli Johnson\[Shrinkage.xlsm]Friday'!A$3:H$32,7,FALSE)
AD3	AD3	=VLOOKUP('Z:\Departmental Shares\dOps\POC Training Material\Intake\Lesli Johnson\[Shrinkage.xlsm]Friday'!$A$4,'Z:\Departmental Shares\dOps\POC Training Material\Intake\Lesli Johnson\[Shrinkage.xlsm]Friday'!A$3:H$32,8,FALSE)
X5:X6	X5	=W5/480
I3:I6,S3:S6	I3	=SUM(E3:H3)
M3:M6	M3	=SUM(K3:L3)

 

[Alex Blakenburg]

I doesn't make sense to just take the next line down based on column Y since the data you are putting in Y has to line up with the date in column A.
What if the next date on a sheet is not the day you are trying to pick up the Shrinkage data for ?
How about having an input box that prompts for the date OR have cell on the spreadsheet that tells it which date you want to process ?
You could use a drop down box for day Monday, Tuesday etc but then we would need a cell to contain a week start or end date.

The next time you post can you put in what time it is at your end or tell me what time zone you are in ?

 

[Saoirse]

Ohh ok, I think I understand what you mean. It definitely would make sense to have the shrinkage info match up with the date from the productivity tracker to verify the date the info goes in on. I just planned on keeping track, but your idea would actually make it even easier! I am so unfamiliar with the abilities of vba and macros and formulas. I really do appreciate all the time and work you are putting in to assist me with this. I hope I am not being overly difficult.

I could easily just put a date in a cell on the Shrinkage sheet to have it match up to the date on the productivity tracker.

I am in the Eastern Standard Time zone.

so i can add the dates in column B or I could I just name the sheets the date? Would that make it easier?
So instead of the sheeting being named "Monday" "Tuesday" ect, they could be "2.14.22" "2.15.22" or would that screw too much up? I am only trying to make it easier to see if this process is possible.

Copy of send to self.xlsx
	A	B	C	D	E	F	G	H	I
1	Enter the minutes worked for each category. EX: 1 hour = 60; 2 hours = 120	2/14/2022	Compliance	System issues	Frontier	Letters / Special projects	Call pulls, fee calculations, large cases	Buzz, trianing, coaching	Approved by: (input which leader approved)
2
3	Alexis
4	Allie		60	10	80	45	20	30
5	Aaron			6		68
6	Breonna		30	15			25	30
7	Brittany
8	Carl
9	Cindy
10	Courtney		120	10	120		10
Sheet1

 

[Saoirse]

Also, when I replace with the new code, I got this error:

 

[Alex Blakenburg]

Can we start with getting the code to run and see what you think.
I don't know what happened but the code seems to have lost the closing bracket ")" on the yellow highlighted line.
Can you add that to it and run it again ?

 

[Saoirse]

Sub CopyShrinkage()

' Lookups are based on Individual's names in the sheetname
' Date using Day of Week as Shrinkage Sheet name

Dim wbProd As Workbook, wbShrink As Workbook
Dim shtProd As Worksheet, shtShkDay As Worksheet
Dim prdFirstRow As Long, prdLastRow As Long
Dim shkFirstRow As Long, shkLastRow As Long
Dim dtCell As Range, dtCellDay As String
Dim persName As String, shkPersRow As Variant
Dim rngShkName As Range, rngShkPers As Range

Set wbProd = ThisWorkbook
Set wbShrink = Workbooks("Shrinkage.xlsm")

prdFirstRow = 3
shkFirstRow = 3

For Each shtProd In wbProd.Worksheets
' Test for Names of sheets in Productivity Tracker that are not names of people and need to be excluded
If shtProd.Name <> "Adjustments" And _
shtProd.Name <> "Compilation" And _
shtProd.Name <> "timing" Then
prdLastRow = shtProd.Range("A" & Rows.Count).End(xlUp).Row
' Get Person name from sheet name
persName = shtProd.Name

For Each dtCell In wbShrink.Range("A" & shkFirstRow & ":A" & shkLastRow)
dtCellDay = Format(dtCell, "dddd")
On Error Resume Next
Set shtShkDay = wbShrink.Worksheets(dtCellDay)
If Err Then
MsgBox "Prod Sheet: " & vbTab & shtProd.Name & vbLf & _
"Cell: " & vbTab & vbTab & dtCell.Address & vbLf & _
"Cell Value: " & vbTab & dtCell & vbLf & _
"WeekDay Sheet: " & vbTab & dtCellDay
Exit Sub
End If
On Error GoTo 0
shkLastRow = shtShkDay.Range("A" & Rows.Count).End(xlUp).Row
Set rngShkName = shtShkDay.Range("A1" & ":A" & shkLastRow)

If Not IsError(Application.Match(persName, rngShkName, 0)) Then
shkPersRow = Application.Match(persName, rngShkName, 0)

Set rngShkPers = shtShkDay.Range("C" & shkPersRow & ":H" & shkPersRow)
shtProd.Range("Y" & dtCell.Row).Resize(, rngShkPers.Columns.Count).Value = rngShkPers.Value

End If

Next dtCell
End If

Next shtProd

End Sub


Same error, same line. The closing bracket is still there. I double checked that as well.

I'm sending images of the actual charts and maybe that could help if you actually saw them with the tabs? Not sure. I am willing to try anything.

This is the Productivity tracker

This is the productivity tracker continued, to the right side of the screen, since the first image got cut off.

This part is the shrinkage sheet.

I don't know if seeing the charts will help. But it is worth a shot. I have been researching how to update the code, but my beginner status is definitely not helping.

Again, thank you for not giving up on me so far. I really appreciate everything you are doing to help me.

 

[Alex Blakenburg]

The line it is erroring out on is not the original line in the code that I gave you. Please change it back to:

                For Each dtCell In shtProd.Range("A" & prdFirstRow & ":A" & prdLastRow)

and then let me know how you go.

 

[Alex Blakenburg]

Is there any reason you have merged rows 1 & 2 on your shrinkage worksheet ? Merging cells is almost always a really bad idea and merging rows 1 and 2 doesn't seem to serve any purpose.
Also I was working on the assumption that the productivity tracker was just 1 week's worth of data, it looks like it is a running list for a calendar month, is that correct ?

 

[Saoirse]

OK, I ran it with that line corrected and got this:

I was asking myself the same question the other day, why those are merged. I Now unmerged them. So row 2 is the first employee name.

To answer your second question, the Productivity tracker is not set up for a specific timeframe. Everyday it adds one more row of data, on and on forever. I just created it and started adding data on Feb 1st. That is why it appears that way.

 

[Alex Blakenburg]

Thanks for that.
Try the below:-

• It will ask you to enter the date you want to copy in from the Shrinkage sheet.
• It will convert that date to the Day of the week and go looking for that sheet.
• It currently assumes that you have the date in B1 in each Shrinkage sheet to make sure you have the right week's Shrinkage sheet.
  You can remove this check if you don't want to put a date in B1
• It will look through each productivity tracker sheet that is not excluded and find that date and bring in the shrinkage data

Let me know how you go.

Sub CopyShrinkage_process_InputDate()

    ' Lookups are based on Individual's names in the sheetname
    ' Date using Day of Week as Shrinkage Sheet name
    
    Dim wbProd As Workbook, wbShrink As Workbook
    Dim shtProd As Worksheet, shtShkDay As Worksheet
    Dim prdFirstRow As Long, prdLastRow As Long
    Dim shkFirstRow As Long, shkLastRow As Long
    Dim dtCell As Range                         ' XXX Should not be required
    Dim strCellDay As String
    Dim persName As String, shkPersRow As Variant
    Dim rngShkName As Range, rngShkPers As Range

    Set wbProd = ThisWorkbook
    Set wbShrink = Workbooks("Shrinkage.xlsm")
    
    prdFirstRow = 3
    shkFirstRow = 3
    
    ' Input Date to process
    Dim strInput As String
    Dim dtInput As Date
    Dim prdRowNo As Long
    
    strInput = Application.InputBox(prompt:="Enter Date to Process: ", Default:=FormatDateTime(Date, vbShortDate), Type:=2)
    If Not IsDate(strInput) Then
        MsgBox "Not a valid date, please try again"
        Exit Sub
    End If
    
    dtInput = CDate(strInput)
    strCellDay = Format(dtInput, "dddd")
        
    On Error Resume Next
        Set shtShkDay = wbShrink.Worksheets(strCellDay)
        If Err Then
            MsgBox "The Shrinkage Workbook does not have a sheet " & vbLf & _
                   "For: " & vbTab & strCellDay
            Exit Sub
        End If
    On Error GoTo 0
    
    '------ Checks Shrinkage sheet cell B1 to see if it is the same date -----
    ' remove this if the Shrinkage sheet doesn't contain dates in B1
    If CLng(dtInput) <> CLng(shtShkDay.Range("B1").Value) Then
        MsgBox "Date Entered is in a different week to Shrinkage workbook" & vbLf _
                & "Input Date was: " & vbTab & FormatDateTime(dtInput, vbShortDate) & vbLf _
                & "This is: " & vbTab & vbTab & strCellDay & vbLf _
                & "Which is dated: " & vbTab & FormatDateTime(shtShkDay.Range("B1").Value, vbShortDate)
        Exit Sub
    End If
    '--------------------------------------------------------------------------
    shkLastRow = shtShkDay.Range("A" & Rows.Count).End(xlUp).Row
    Set rngShkName = shtShkDay.Range("A1" & ":A" & shkLastRow)
        
    For Each shtProd In wbProd.Worksheets
        ' Test for Names of sheets in Productivity Tracker that are not names of people and need to be excluded
        If shtProd.Name <> "Adjustments" And _
            shtProd.Name <> "Compilation" And _
            shtProd.Name <> "timing" Then
                prdLastRow = shtProd.Range("A" & Rows.Count).End(xlUp).Row
                ' Get Person name from sheet name
                persName = shtProd.Name
                
                ' Find Input Date in Person's sheet
                With Application
                    prdRowNo = .IfError(.Match(CLng(dtInput), shtProd.Columns(1), 0), 0)
                End With
                
                ' Find Person's Name in Shrinkage sheet for the day of the week matching the input date
                If Not IsError(Application.Match(persName, rngShkName, 0)) Then
                    shkPersRow = Application.Match(persName, rngShkName, 0)
                    
                        Set rngShkPers = shtShkDay.Range("C" & shkPersRow & ":H" & shkPersRow)
                        shtProd.Range("Y" & prdRowNo).Resize(, rngShkPers.Columns.Count).Value = rngShkPers.Value
                Else
                        ' Remove this if it is a common occurence for people not being on the Shrinkage sheet
                        MsgBox persName & " Not found on " & strCellDay
                End If
                
        End If
    
    Next shtProd

End Sub

 

[Saoirse]

Holy Crapola!!! It Works!! Oh MY Goodness, This is amazing! I don't know how you did it, but you did!!! Thank you SOOO MUCH!

I do get these errors when I run it though.

Not sure if it is because I don't have EVERY employee tab filled in on the productivity tracker or not. But that could be it.