Copy values to a table when a new date is entered

Cyruz

New Member
Joined
Dec 2, 2021
Messages
3
Office Version
  1. 2021
Platform
  1. Windows
Hello experts,

To begin with; I am happy I have found this forum. Browsing here has helped me in the past with figuring out things that for the most of you is pretty straightforward, but for me completely new.
This time I wasn't able to solve my problem by going through the topics, so I could use some help.

The situation:

Every day, during the day, data will be entered in a input sheet; B2 to G2 (the date will be entered manual (A1)). This data will be used to generate a report at the end of the day.
My wish: I would like to create a table that will grow (row) every time a new date will be entered (A1 on Input). The new row will have the data corresponding to the date that has been entered. As long as the entered date stays the same the row will be overwritten as new data will be entered during the day.

I hope I managed to explain what I like to achieve.

Thanks in advance!
 

Attachments

  • ee431acc0df1fd3c526d0b4afb4eb9fa.png
    ee431acc0df1fd3c526d0b4afb4eb9fa.png
    33 KB · Views: 14
  • f87a08959d944dc2e81481efdb78ae07.png
    f87a08959d944dc2e81481efdb78ae07.png
    31.1 KB · Views: 13

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.
With table1 in sheet2

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws1, ws2 As Worksheet
Dim MyTbl As Object
Dim m As Long
Set ws1 = ThisWorkbook.Sheets("sheet1")
Set ws2 = ThisWorkbook.Sheets("sheet2")
Set MyTbl = ws2.ListObjects("Table1")
    If Not Intersect(Target, ws1.Range("A1")) Is Nothing Then
        If Target <> MyTbl.Range(MyTbl.ListRows.Count + 1, 1) Then
            With MyTbl.ListRows.Add
            .Range(1) = ws1.Range("A1").Value
            .Range(2).Resize(, 6) = ws1.Range("B2:G2").Value
            End With
        End If
    End If
    If Not Intersect(Target, ws1.Range("B2:G2")) Is Nothing Then
        m = WorksheetFunction.Match(ws1.Range("A1"), MyTbl.ListColumns(1).Range, 0)
        MyTbl.ListRows(m - 1).Range(2).Resize(, 6) = ws1.Range("B2:G2").Value
    End If
End Sub

b1.xlsm
ABCDEFG
102-JanPlanningGemaaktVerschilDirecte afkeurBokkadeBinC
211015203050
Sheet1


b1.xlsm
ABCDEFG
1DatePlanningGemaaktVerschilDirecte afkeurBokkadeBinC
2
301-Jan30.199590350275100
402-Jan11015203050
Sheet2
 
Upvote 0
Solution
With table1 in sheet2

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws1, ws2 As Worksheet
Dim MyTbl As Object
Dim m As Long
Set ws1 = ThisWorkbook.Sheets("sheet1")
Set ws2 = ThisWorkbook.Sheets("sheet2")
Set MyTbl = ws2.ListObjects("Table1")
    If Not Intersect(Target, ws1.Range("A1")) Is Nothing Then
        If Target <> MyTbl.Range(MyTbl.ListRows.Count + 1, 1) Then
            With MyTbl.ListRows.Add
            .Range(1) = ws1.Range("A1").Value
            .Range(2).Resize(, 6) = ws1.Range("B2:G2").Value
            End With
        End If
    End If
    If Not Intersect(Target, ws1.Range("B2:G2")) Is Nothing Then
        m = WorksheetFunction.Match(ws1.Range("A1"), MyTbl.ListColumns(1).Range, 0)
        MyTbl.ListRows(m - 1).Range(2).Resize(, 6) = ws1.Range("B2:G2").Value
    End If
End Sub

b1.xlsm
ABCDEFG
102-JanPlanningGemaaktVerschilDirecte afkeurBokkadeBinC
211015203050
Sheet1


b1.xlsm
ABCDEFG
1DatePlanningGemaaktVerschilDirecte afkeurBokkadeBinC
2
301-Jan30.199590350275100
402-Jan11015203050
Sheet2

Thank you bebo21999!

The script does exactly what I asked for!

I know I asked for adding a new row at the bottom of the table, but would it also be possible to add it at the top, so other rows will be shifted down on entering a new date. I tried playing with the code but my VBA knowledge is minimal.

Or if there is a way to make the table sort itself, so the last entered dates will be on top of the table. I know the manual way, but it would be great it it would be done automatic.

Thanks again for your help!
 
Upvote 0
Not yet test since not at PC now, just: listrows.Add(1)
A quick test from work; Works perfect!

I added the (1) behind the : "With MyTbl.ListRows.Add" . So it became: "With MyTbl.ListRows.Add (1)".

Thank you!

I know this isn't the most beautiful way, because rows can be added with the same date, but it works! Eventually 3 shifts (A, B and C) will have to use this sheet, so I need to think of a way how to
separate 3 similar dates in the same table for each shift to generate a final report. But that is something I need to research myself first.

Much appreciation for your help.
 
Upvote 0
You can see the 2nd IF to prevent duplicate date entry. Just remove it.
 
Upvote 0

Forum statistics

Threads
1,213,558
Messages
6,114,296
Members
448,564
Latest member
ED38

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top