Periodically Copying Concatenated Data in Excel To Second Sheet While Primary Sheet Remains Active for Data Entry

I am pulling data from various cells on Sheet1 in Excel and copying the values to specific cells on a row in Sheet2 every specified period of time. I almost have my project completed but am unable to copy concatenated data in the same manner. How would I incorporate the following excel statement into my code for the data to be copied on sheet2 from sheet1? The output should go into cell AB on Sheet2.

Not to confuse the issue but the reason the code is done in this manner is so that data can be entered on sheet 1 which will be the active sheet on the screen at all times but data will be periodically be saved to sheet2.

Excel Statement i need to incorporate and output to Cell "AB" on sheet2:

=CONCATENATE(Sheet1!I9,", ",Sheet1!I10,", ",Sheet1!I11,", ",Sheet1!I12)


Current Code:

Option Explicit
Public dTime As Date

Sub ValueStore()

Dim dTime As Date

Dim ws1 As Worksheet
Dim ws2 As Worksheet

Set ws1 = ActiveWorkbook.Worksheets("Sheet1")
Set ws2 = ActiveWorkbook.Worksheets("Sheet2")

Dim lRow As Long
lRow = ws2.Range("A" & Rows.Count).End(xlUp).Row

With ws2
Range("X1:X" & lRow).Offset(1).Value = ws1.Range("F15").Value
Range("Y1:Y" & lRow).Offset(1).Value = ws1.Range("F14").Value
Range("Z1:Z" & lRow).Offset(1).Value = ws1.Range("F17").Value
Range("AA1:AA" & lRow).Offset(1).Value = ws1.Range("F16").Value

End With

StartTimer1

End Sub


Sub StartTimer1()
dTime = Now + TimeValue("00:00:05")
Application.OnTime dTime, "ValueStore", Schedule:=True
End Sub

Sub StopTimer1()
On Error Resume Next
Application.OnTime dTime, "ValueStore", Schedule:=False
End Sub


Your code fills the whole column on sheet2 with each single value from sheet1: is that what you want?
– Tim Williams
Jun 29 at 21:55

I am trying to have it only replace the current row it is writing on sheet2 and leave the other entries in the column above it intact.
– Steve
Jun 29 at 21:58

1 Answer
1

Try this:

Sub ValueStore()

Dim dTime As Date, rw As Range

Dim ws1 As Worksheet
Dim ws2 As Worksheet

Set ws1 = ActiveWorkbook.Worksheets("Sheet1")
Set ws2 = ActiveWorkbook.Worksheets("Sheet2")

'find the next empty row on ws2
Set rw = ws2.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).EntireRow

With rw
' note the .Range() here is *relative* to rw
.Range("A1").Value = Now '<< ensure a value is placed in colA....
.Range("X1").Value = ws1.Range("F15").Value
.Range("Y1").Value = ws1.Range("F14").Value
.Range("Z1").Value = ws1.Range("F17").Value
.Range("AA1").Value = ws1.Range("F16").Value
'method1 (contiguous vertical range)
.Range("AB1").Value = Join(Application.Transpose(ws1.Range("I9:I12").Value), ", ")
'method2 (join individual cells)
.Range("AB1").Value = Join(Array(ws1.Range("I9"), ws1.Range("I10"), _
ws1.Range("I11"), ws1.Range("I12")), ", ")

End With

StartTimer1

End Sub


Thank you so much Tim, that worked perfectly!!
– Steve
Jun 29 at 22:24

By clicking "Post Your Answer", you acknowledge that you have read our updated terms of service, privacy policy and cookie policy, and that your continued use of the website is subject to these policies.