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

Ruslan

New Member
Joined
Feb 18, 2021
Messages
6
Office Version
  1. 2016
Platform
  1. Windows
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
 

Attachments

  • simplified table.JPG
    simplified table.JPG
    20.3 KB · Views: 8

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).

kanadaaa

Active Member
Joined
Dec 29, 2019
Messages
348
Office Version
  1. 365
Platform
  1. Windows
Try this in the sheet's module:
VBA Code:
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

New Member
Joined
Feb 18, 2021
Messages
6
Office Version
  1. 2016
Platform
  1. Windows
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

Active Member
Joined
Dec 29, 2019
Messages
348
Office Version
  1. 365
Platform
  1. Windows
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:

Capture01.PNG
 

kanadaaa

Active Member
Joined
Dec 29, 2019
Messages
348
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

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

Ruslan

New Member
Joined
Feb 18, 2021
Messages
6
Office Version
  1. 2016
Platform
  1. Windows
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
BCDE
1Datedate1date2date3
205-Jan
305-Jan06-Jan
401-Jan
501-Jan06-Jan10-Jan
601-Jan
Sheet1
 

kanadaaa

Active Member
Joined
Dec 29, 2019
Messages
348
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

Try the code below in a standard module:
VBA Code:
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
VBA Code:
Sheets("Sheet1").Range("XFD1").Clear
 
Solution

kanadaaa

Active Member
Joined
Dec 29, 2019
Messages
348
Office Version
  1. 365
Platform
  1. Windows
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.
VBA Code:
lr = .Range("C" & Rows.Count).End(xlUp).Row
 

Ruslan

New Member
Joined
Feb 18, 2021
Messages
6
Office Version
  1. 2016
Platform
  1. Windows
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.

VBA Code:
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

New Member
Joined
Feb 18, 2021
Messages
6
Office Version
  1. 2016
Platform
  1. Windows
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...
 

Watch MrExcel Video

Forum statistics

Threads
1,130,433
Messages
5,642,087
Members
417,256
Latest member
JessAw

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
Top