Excel vba to transfer value to another sheet based on date and number

[ExcelNewbie2020]

i have a task to update the attendance daily (sheet 1). i was thinking of preparing a summary on sheet 2 then will auto-update it to sheet 1 with a button.

would it be possible to transfer the value from sheet 2 to sheet 1 based on the date and emp. #?. while those not included in the update will just carry over based on previous value..

testing.xlsx
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V
1	SHEET 1											SHEET 2
2
3	NAME	EMP.#	22-02-23	23-02-23	24-02-23	25-02-23	26-02-23	27-02-23	28-02-23	01-03-23	02-03-23	EMP.#	DATE	24-02-23	25-02-23	26-02-23	27-02-23	28-02-23	01-03-23	02-03-23
4	NAME1	101	F	F	F	F	F	F	F	F	F	102	24-02-23	T	8	8	8	8	8	8
5	NAME2	102	V	V	T	8	8	8	8	8	8	107	24-02-23	T	8	8	8	8	8	8
6	NAME3	103	F	F	F	F	F	F	F	F	F	111	24-02-23	T	8	8	8	8	8	8
7	NAME4	104	8	8	8	8	8	8	8	8	8	114	24-02-23	T	8	8	8	8	8	8
8	NAME5	105	8	8	8	8	8	8	8	8	8
9	NAME6	106	8	8	8	8	8	8	8	8	8
10	NAME7	107	F	F	T	8	8	8	8	8	8
11	NAME8	108	F	F	F	F	F	F	F	F	F
12	NAME9	109	F	F	F	F	F	F	F	F	F
13	NAME10	110	F	F	F	F	F	F	F	F	F
14	NAME11	111	S	S	T	8	8	8	8	8	8
15	NAME12	112	V	V	V	V	V	V	V	V	V
16	NAME13	113	E	E	E	E	E	E	E	E	E
17	NAME14	114	F	F	T	8	8	8	8	8	8
18	NAME15	115	8	8	8	8	8	8	8	8	8
19
20
21
22
Sheet28

 

[ExcelNewbie2020]

Will the date be the same for each EMP# in sheet2 for each time the macro is run or could EMP102 be 24/02/2023 & EMP107 bet 26/02/2023?

should be same date in that column B for each EMP#

 

[Georgiboy]

Maybe something like:

Sub test()
    Dim fRng As Range, fVar As Variant, f As Long
    Dim tRng As Range, tVar As Variant, t As Long
    Dim x As Long, c As Long, tmp As Date, z As Long
    
    Set fRng = Sheet2.UsedRange
    With fRng
        Set fRng = .Offset(1).Resize(.Rows.Count - 1)
    End With
    fVar = fRng.Value
    
    Set tRng = Sheet1.UsedRange
    tVar = tRng.Value
    z = 3
    
    tmp = Sheet2.Range("B2")
    For x = 3 To UBound(tVar, 2)
        If tVar(1, x) = tmp Then
            c = x: Exit For
        End If
    Next x
    
    For t = 2 To UBound(tVar)
        For f = 1 To UBound(fVar)
            If tVar(t, 2) = fVar(f, 1) Then
                For x = c To c + 6
                    tVar(t, x) = fVar(f, z): z = z + 1
                Next x
                z = 3
                Exit For
            Else
                For x = c To c + 6
                    tVar(t, x) = tVar(t, x - 1)
                Next x
            End If
        Next f
    Next t
    tRng = tVar
End Sub

 

[Georgiboy]

Or maybe just a range loop:

Sub test()
    Dim dt As Date
    Dim rCell As Range
    Dim c As Long
    Dim fRng As Range
   
    dt = Sheet2.Range("B2")
    c = Sheet1.Range("A1:XFD1").Find(dt).Column - 2
   
    For Each rCell In Sheet1.Range("B2:B" & Sheet1.Range("B" & Rows.Count).End(xlUp).Row).Cells
        Set fRng = Sheet2.Range("A:A").Find(rCell.Value)
        If Not fRng Is Nothing Then
            rCell.Offset(, c).Resize(, 7).Value = fRng.Offset(, 2).Resize(, 7).Value
        Else
            rCell.Offset(, c).Resize(, 7).Value = rCell.Offset(, c - 1).Value
        End If
        Set fRng = Nothing
    Next rCell
End Sub

 

[ExcelNewbie2020]

Or maybe just a range loop:

Sub test()
    Dim dt As Date
    Dim rCell As Range
    Dim c As Long
    Dim fRng As Range
  
    dt = Sheet2.Range("B2")
    c = Sheet1.Range("A1:XFD1").Find(dt).Column - 2
  
    For Each rCell In Sheet1.Range("B2:B" & Sheet1.Range("B" & Rows.Count).End(xlUp).Row).Cells
        Set fRng = Sheet2.Range("A:A").Find(rCell.Value)
        If Not fRng Is Nothing Then
            rCell.Offset(, c).Resize(, 7).Value = fRng.Offset(, 2).Resize(, 7).Value
        Else
            rCell.Offset(, c).Resize(, 7).Value = rCell.Offset(, c - 1).Value
        End If
        Set fRng = Nothing
    Next rCell
End Sub

thanks man, Both work in the sample file, but this one is easier to understand when i update the script with my actual file.. I really appreciate your effort sir..

 

[ExcelNewbie2020]

Or maybe just a range loop:

Sub test()
    Dim dt As Date
    Dim rCell As Range
    Dim c As Long
    Dim fRng As Range
  
    dt = Sheet2.Range("B2")
    c = Sheet1.Range("A1:XFD1").Find(dt).Column - 2
  
    For Each rCell In Sheet1.Range("B2:B" & Sheet1.Range("B" & Rows.Count).End(xlUp).Row).Cells
        Set fRng = Sheet2.Range("A:A").Find(rCell.Value)
        If Not fRng Is Nothing Then
            rCell.Offset(, c).Resize(, 7).Value = fRng.Offset(, 2).Resize(, 7).Value
        Else
            rCell.Offset(, c).Resize(, 7).Value = rCell.Offset(, c - 1).Value
        End If
        Set fRng = Nothing
    Next rCell
End Sub

sir, the code is working fine..however, I encounter issues on my data.. i mentioned before that if the EMP# does not exist in sheet 2 the script will just copy the values from the previous day of the sheet 1.. I found out that this will affect the previously updated EMP#..

Sir, would it be possible to add another line in the script that it should ignore the copy of previous value if the previous value is "T". thank you very much..

 

[Georgiboy]

Like this?

Sub test()
    Dim dt As Date
    Dim rCell As Range
    Dim c As Long
    Dim fRng As Range
  
    dt = Sheet2.Range("B2")
    c = Sheet1.Range("A1:XFD1").Find(dt).Column - 2
  
    For Each rCell In Sheet1.Range("B2:B" & Sheet1.Range("B" & Rows.Count).End(xlUp).Row).Cells
        Set fRng = Sheet2.Range("A:A").Find(rCell.Value)
        If Not fRng Is Nothing Then
            rCell.Offset(, c).Resize(, 7).Value = fRng.Offset(, 2).Resize(, 7).Value
        Else
            If rCell.Offset(, c - 1).Value <> "T" Then
                rCell.Offset(, c).Resize(, 7).Value = rCell.Offset(, c - 1).Value
            End If
        End If
        Set fRng = Nothing
    Next rCell
End Sub

 

[ExcelNewbie2020]

Like this?

Sub test()
    Dim dt As Date
    Dim rCell As Range
    Dim c As Long
    Dim fRng As Range
 
    dt = Sheet2.Range("B2")
    c = Sheet1.Range("A1:XFD1").Find(dt).Column - 2
 
    For Each rCell In Sheet1.Range("B2:B" & Sheet1.Range("B" & Rows.Count).End(xlUp).Row).Cells
        Set fRng = Sheet2.Range("A:A").Find(rCell.Value)
        If Not fRng Is Nothing Then
            rCell.Offset(, c).Resize(, 7).Value = fRng.Offset(, 2).Resize(, 7).Value
        Else
            If rCell.Offset(, c - 1).Value <> "T" Then
                rCell.Offset(, c).Resize(, 7).Value = rCell.Offset(, c - 1).Value
            End If
        End If
        Set fRng = Nothing
    Next rCell
End Sub

it works like a charm.. thank you sir