[VBA] Copy/Paste different values based on date

[Yooks]

Hi peeps,

I want a VBA that will automatically copy/paste data from sheet1 to sheet2.​

It should copy the Oracle value(D4:D8), Name(E4:E8), Code(F4:F8) and the date of the day (F2).​

​

​

So in example below. I have 4 agents, they were all present on April 2nd.​

I now want to move all that data onto sheet2 in the sheet below.​

​

Now when we get to tomorrow I want it to copy the same but for April 3rd (G2).​

It should not overwrite any additional data. It should not copy the data if the code cell is blank (F4:F8)​

 

[Michael M]

Maybe this then

Sub MM1()
 Dim lr As Long, lr2 As Long, r As Long, ws1 As Worksheet, ws2 As Worksheet
 Set ws1 = Sheets("Sheet1")
 Set ws2 = Sheets("Sheet2")
 lr = ws1.Cells(Rows.Count, "D").End(xlUp).Row
 lr2 = ws2.Cells(Rows.Count, "D").End(xlUp).Row
 With ws1
     For r = 4 To lr
        If .Cells(r, 6).Value = "P" Then
            .Range(Cells(r, 4), Cells(r, 6)).Copy ws2.Cells(lr2 + 1, 4)
            lr2 = ws2.Cells(Rows.Count, "D").End(xlUp).Row
        End If
    Next r
End With
End Sub

 

[Michael M]

Sorry , a typo in there....Try

Sub MM1()
 Dim lr As Long, lr2 As Long, r As Long, ws1 As Worksheet, ws2 As Worksheet
 Set ws1 = Sheets("Sheet1")
 Set ws2 = Sheets("Sheet2")
 lr = ws1.Cells(Rows.Count, "D").End(xlUp).Row
 lr2 = ws2.Cells(Rows.Count, "A").End(xlUp).Row
 With ws1
     For r = 4 To lr
        If .Cells(r, 6).Value = "P" Then
            .Range(Cells(r, 4), Cells(r, 6)).Copy ws2.Cells(lr2 + 1, 1)
            ws2.Cells(lr2 + 1, 4).Value = .Cells(2, 6)
            lr2 = ws2.Cells(Rows.Count, "A").End(xlUp).Row
        End If
    Next r
End With
End Sub

 

[Yooks]

Sorry , a typo in there....Try

Sub MM1()
Dim lr As Long, lr2 As Long, r As Long, ws1 As Worksheet, ws2 As Worksheet
Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")
lr = ws1.Cells(Rows.Count, "D").End(xlUp).Row
lr2 = ws2.Cells(Rows.Count, "A").End(xlUp).Row
With ws1
     For r = 4 To lr
        If .Cells(r, 6).Value = "P" Then
            .Range(Cells(r, 4), Cells(r, 6)).Copy ws2.Cells(lr2 + 1, 1)
            ws2.Cells(lr2 + 1, 4).Value = .Cells(2, 6)
            lr2 = ws2.Cells(Rows.Count, "A").End(xlUp).Row
        End If
    Next r
End With
End Sub

Hello,

Thank you very much for the help.

This is what we have so far.

So it has successfully moved the data from Sheet1 to Sheet 2.

I should clarify that column D containing the Oracle values will be a index match formula. So I assume once I use on real data it will copy the formula?

I would also need it copy from the column that matches the present date.

So today, the correct date column if F. Tomorrow it will be G. How do I make it search for =TODAY() IN 3:3 to then pull the rest of the data from the rows in that column?
Also Values in the code column can vary between 5 different values. In this case "P", "WO", "PTO", "NCNS", "ABSENT"

 

[Michael M]

Ok, I'd suggest giving us ALL the required information rather than adding further criteria as we go....it just means we will be constantly rewriting the code to suit new requirements.
Have a look at using the XL2BB download in my tag and posting using it , rather than posting pictures that we can't use to test the data.

 

[Yooks]

Ok, I'd suggest giving us ALL the required information rather than adding further criteria as we go....it just means we will be constantly rewriting the code to suit new requirements.
Have a look at using the XL2BB download in my tag and posting using it , rather than posting pictures that we can't use to test the data.

Thank you for the suggestion. I have set up XL2BB. You can see the below table. Grateful for your knowledge and help with this!

NCNS And Absent will have a simple =Countif - But since they're not needed in this task I have left out their formulas.

As you can see below. We have data for April 2nd. Now it is April 3rd we would want to copy from that column.

AbsenseTest.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P
1
2		Agent Overview				02-Apr	03-Apr	04-Apr	05-Apr	06-Apr	07-Apr	08-Apr	09-Apr	10-Apr	11-Apr	12-Apr
3		NCNS	Absent	Oracle	Name	Fri	Sat	Sun	Mon	Tue	Wed	Thu	Fri	Sat	Sun	Mon
4				1234	Sample Name	P	P
5				12345	Sample Name 1	P	P
6				12346	Sample Name 2	P	NCNS
7				12347	Sample Name 3	P	P
8				12348	Sample Name 4	P	WO
9
10
Sheet1

Cell Formulas
Range	Formula
G2:P2	G2	=F2+1
F3:P3	F3	=TEXT(F2,"DDD")
D4:D8	D4	=INDEX(ALL[#All],MATCH(Sheet1!E4,ALL!$E$3:$E$144,0)+1,2)

Cells with Data Validation
Cell	Allow	Criteria
F4:P8	List	P,WO,PTO,NCNS,ABSENT

 

[Michael M]

edit....misread

 

[Michael M]

UNTESTED

Sub MM1()
 Dim lr As Long, lr2 As Long, r As Long, ws1 As Worksheet, ws2 As Worksheet
 Dim lc As Integer
 Set ws1 = Sheets("Sheet1")
 Set ws2 = Sheets("Sheet2")
 lc = ws1.Cells(4, Columns.Count).End(xlToLeft).Column
 lr = ws1.Cells(Rows.Count, "D").End(xlUp).Row
 lr2 = ws2.Cells(Rows.Count, "A").End(xlUp).Row
 With ws1
     For r = 4 To lr
        If .Cells(r, lc).Value <> "" Then
            .Range(Cells(r, 4), Cells(r, lc)).Copy ws2.Cells(lr2 + 1, 1)
            ws2.Cells(lr2 + 1, 4).Value = .Cells(2, lc).Value
            lr2 = ws2.Cells(Rows.Count, "A").End(xlUp).Row
        End If
    Next r
End With
End Sub

 

[Michael M]

Another edit

Sub MM1()
 Dim lr As Long, lr2 As Long, r As Long, ws1 As Worksheet, ws2 As Worksheet
 Dim lc As Integer
 Set ws1 = Sheets("Sheet1")
 Set ws2 = Sheets("Sheet2")
lc = Evaluate("COUNTIF(D4:P4,""<>"")") + 3
 lr = ws1.Cells(Rows.Count, "D").End(xlUp).Row
 lr2 = ws2.Cells(Rows.Count, "A").End(xlUp).Row
 With ws1
     For r = 4 To lr
        If .Cells(r, lc).Value <> "" Then
            .Range(Cells(r, 4), Cells(r, lc)).Copy ws2.Cells(lr2 + 1, 1)
            ws2.Cells(lr2 + 1, 4).Value = .Cells(2, lc).Value
            lr2 = ws2.Cells(Rows.Count, "A").End(xlUp).Row
        End If
    Next r
End With
End Sub

 

[Yooks]

Thanks for the help Michael. I have edited the code a little.

So what this does now is checks to see weather the row matching the date column has data.
Then it will proceed to paste column 4(D) and 5(E).

I have also made it so it will paste Today() in the 4th(D) column in Sheet2

Sub MM1()
 Dim lr As Long, lr2 As Long, r As Long, ws1 As Worksheet, ws2 As Worksheet
 Dim lc As Integer
 Set ws1 = Sheets("Sheet1")
 Set ws2 = Sheets("Sheet2")
 lc = Evaluate("MATCH(TODAY(),2:2,0)")
 lr = ws1.Cells(Rows.Count, "E").End(xlUp).Row
 lr2 = ws2.Cells(Rows.Count, "A").End(xlUp).Row
 With ws1
     For r = 4 To lr
        If .Cells(r, lc).Value <> "" Then
            .Range(Cells(r, 4), Cells(r, 5)).Copy
            ws2.Cells(lr2 + 1, 1).PasteSpecial xlPasteValues
            ws2.Cells(lr2 + 1, 4).Value = Evaluate("Today()")
            lr2 = ws2.Cells(Rows.Count, "A").End(xlUp).Row
        End If
    Next r
End With
End Sub

This is the outcome so far

AbsenseTest.xlsm
	A	B	C	D
1	Oracle	Name	Code	Date
2	12345	Sample Name 1		03/04/2021
Sheet2

Now for the final task. I need a way to paste the "Code" value from the specified date column only. Into sheet 2
For today. That column would be H.

AbsenseTest.xlsm
	A	B	C	D	E	F	G	H
1
2		Agent Overview				01-Apr	02-Apr	03-Apr
3		NCNS	Absent	Oracle	Name	Thu	Fri	Sat
4				1234	Sample Name	P	P
5				12345	Sample Name 1	P	P	P
6				12346	Sample Name 2	P	NCNS
7				12347	Sample Name 3	WO	P
8				12348	Sample Name 4	P	WO
9
10
11
Sheet1

Cell Formulas
Range	Formula
G2:H2	G2	=F2+1
F3:H3	F3	=TEXT(F2,"DDD")
D4:D8	D4	=INDEX(ALL[#All],MATCH(Sheet1!E4,ALL!$E$3:$E$144,0)+1,2)

Cells with Data Validation
Cell	Allow	Criteria
F4:H8	List	P,WO,PTO,NCNS,ABSENT