Cut-paste values to the first empty cell of the same row in Excel using VBA

[Ruslan]

Hi community!
I've been following the site for many years and got a lot of amazing VBA solutions here.
Now I have finally registered to seek for your kind help.

So I have an excel table with several hundreds rows. Users of the file enter values in the column date; not all cells of the column but usually 20-30 at a time, several times per year. This column is followed by columns date1, date2, date3 and so on and so forth. I was looking for a macro which can take each value from date (once entered by a user) and place it in the first empty cell of the same row.
In the simplified table on the picture, from the column date 15-Jan should go to column date3, 6-Feb to date4 (the table I believe will be automatically extended when the value is pasted next to its last column), 7-Feb to date2.

All the pieces of code which I found on web are focusing on columns rather than on rows, so I cannot come up with a workable solution alone even after hours spent for searching and testing.
Thanks for your help in advance with this simple but complex question

 

[kanadaaa]

Try this in the sheet's module:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim lc As Long
    lc = Cells(Target.Row, Columns.Count).End(xlToLeft).Column + 1
    If Target.Column = 1 And Not IsEmpty(Target) Then
        Cells(Target.Row, 1).Copy Cells(Target.Row, lc)
        Application.CutCopyMode = False
    End If
End Sub

 

[Ruslan]

Try this in the sheet's module:

Thanks, but unfortunately it does not do anything.

As far as I understand the above code, it should take the value from the column date to the first empty cell in the same row right after the value is entered.
However, I can live with a code which will not do it immediately after entering the value in a particular cell, but once the user entered all values in the column. Such thing would even be better for me.
Ideally, it should work as following:

1. User opens the file and entering values in the columns date
2. Once done, he hits a button to run the code
3. The code takes values from the column date and distributes them to the first empty cells of corresponding rows

I'll have a workbook_open macro with Range("Table1[date]").clearContents to be sure that whenever the file is being opened, the entire column date is empty, so no values left there after the previous session.

My apologies for being unclear with the first questions. It is a bit complicated to explain not very familiar things in a language which is not native either ?

 

[kanadaaa]

Thanks, but unfortunately it does not do anything.

That's perhaps because the information you provided wasn't sufficient for us to write a code.
What column is "Date" in?

However, I can live with a code which will not do it immediately after entering the value in a particular cell, but once the user entered all values in the column. Such thing would even be better for me.

That cannot be done automatically and if you want the magic to happen when all data have been input, you'll have to trigger the event manually like by hitting a button, as you suggest.

Once done, he hits a button to run the code

This can be achieved if you prepare a command button on the worksheet.
Freeze the top row and locate the button like so:

 

[kanadaaa]

In addition, I need information on what row the headings are in to write a code.

 

[Ruslan]

In addition, I need information on what row the headings are in to write a code.

the headings are in the first row of the sheet.
I'm placing here the table below, hope it explains better than I do
thanks for the help

Book1 (version 1).xlsm
	B	C	D	E
1	Date	date1	date2	date3
2		05-Jan
3		05-Jan	06-Jan
4		01-Jan
5		01-Jan	06-Jan	10-Jan
6		01-Jan
Sheet1

 

[kanadaaa]

Try the code below in a standard module:

Sub DataAutoFill()
    Dim lc As Long, lr As Long, i As Long
    Sheets("Sheet1").Activate
    With ActiveSheet
        lr = .Range("B" & Rows.Count).End(xlUp).Row
        .Range("XFD1").Value = .Range("XFD1").Value + 1
        Application.ScreenUpdating = False
        For i = 2 To lr '<= Edit the number to 2 if you don't have a command button in row 1 and 3 if you do
            lc = .Cells(i, Columns.Count).End(xlToLeft).Column + 1
            If Not IsEmpty(.Cells(i, "B")) Then
                .Cells(i, "B").Copy .Cells(i, lc)
                Application.CutCopyMode = False
                If .Range("XFD1").Value Mod 2 <> 0 Then
                    .Cells(i, lc).Interior.Color = vbYellow
                End If
            End If
        Next i
        Application.ScreenUpdating = True
    End With
End Sub

And add the following line into ThisWorkbook > Workbook_Open

Sheets("Sheet1").Range("XFD1").Clear

 

[kanadaaa]

Sorry maybe you'll need to replace line 5 with the line below but I can't really tell because I don't know what exactly the worksheet looks like when it's opened.

lr = .Range("C" & Rows.Count).End(xlUp).Row

 

[Ruslan]

Try the code below in a standard module:

Thanks for that!
with some modifications it works as I needed, below is the final code.
The only I didn't get is why I had to enter 2 in lc = Application.WorksheetFunction.CountA(.Rows(i).EntireRow.Cells) + 2 (as for me, should have been 1, but it was overruling value of the last used cell in the row ?), but the most important is that it works.

Sub DataAutoFill()

    Dim lc As Long, lr As Long, i As Long
    Sheets("Sheet1").Activate
    
    With ActiveSheet
        lr = .Range("C" & Rows.Count).End(xlUp).Row
        Application.ScreenUpdating = False
        
        For i = 2 To lr
        lc = Application.WorksheetFunction.CountA(.Rows(i).EntireRow.Cells) + 2
            If Not IsEmpty(.Cells(i, "B")) Then
                .Cells(i, "B").Copy .Cells(i, lc)
                .Cells(i, lc).Interior.Color = vbYellow
                Application.CutCopyMode = False
            End If
         Next i
        
        Application.ScreenUpdating = True
    End With
End Sub

 

[Ruslan]

The only I didn't get is why

ok, I'll answer own question.
The test file had column A empty, the table begins from B, but apparently the code starts counting from the first column in the sheet.
Corrected it to 1, as in the main working file the table begins in col A...