VBA - Insert Current Date in Column

Question

I'm using two files let's name it File 1 and File 2 my script append the data from File 1 to File 2 now every time I append File 2 i want insert Current Date from my Column.

File 1:

Header 1 | Header 2 | Header 3| 1 | 1 | | 1 | 1 | |

File 2

 Header 1 | Header 2 | Header 3| a | a | 3/3/2016| a | a | 3/3/2016|

Sample Output:

Header 1 | Header 2 | Header 3| a | a |3/3/2016 | a | a |3/3/2016 | 1 | 1 |4/4/2016 | 1 | 1 |4/4/2016 |

As you can see the sample output above inserted the current date in `Header 3.

My problem is that if i append the data from File 2 it densest return the current date in Header 3 but if I append it again it updates the last one. to make it clear let's give another example.

Sample Out: (This is the output of my script)

Header 1 | Header 2 | Header 3| a | a |3/3/2016 | a | a |3/3/2016 | 1 | 1 | | 1 | 1 | |

If I append again the data from File 1 this is now the output

 Header 1 | Header 2 | Header 3| a | a |3/3/2016 | a | a |3/3/2016 | 1 | 1 |4/4/2016 | 1 | 1 |4/4/2016 | 1 | 1 | | 1 | 1 | |

I want to insert the current date every time i append a new data, my code insert the date one step behind and i'm connfused gagin with my code @.@ Please Help me!

My Code:

Public Sub addweeklydata() Dim file1 As Excel.Workbook Dim file2 As Excel.Workbook Dim Sheet1 As Worksheet Dim Sheet2 As Worksheet Dim Rng As Range Set Sheet1 = Workbooks.Open(TextBox1.Text).Sheets(1) Set Sheet2 = Workbooks.Open(TextBox2.Text).Sheets(1) lastRow = Sheet2.Range("A" & Rows.Count).End(xlUp).Row For i = 2 To lastRow Sheet2.Cells(i, 4).Value = Date Set Rng = Sheet1.Range("A1").CurrentRegion 'assuming no blank rows/column Set Rng = Rng.Offset(1, 0).Resize(Rng.Rows.Count - 1, Rng.Columns.Count) 'exclude header Next Sheet2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize( _ Rng.Rows.Count, Rng.Columns.Count).Value = Rng.Value Sheet2.Parent.Close True 'save changes Sheet1.Parent.Close False 'don't save End Sub

@SiddharthRout i realllllly want to do that, but my IS wants everything to be automated haha — 7A65726F
– 7A65726F, Commented Apr 4, 2016 at 8:47
Yes I was talking about automation. Also I have a different (faster) approach in mind. Are you oopen for that? — Siddharth Rout
– Siddharth Rout, Commented Apr 4, 2016 at 8:50

Vityata · Accepted Answer · 2016-04-04 09:03:05Z

You have to add the data after you copy the files, something like this:

Public Sub addweeklydata() Dim file1 As Excel.Workbook Dim file2 As Excel.Workbook Dim Sheet1 As Worksheet Dim Sheet2 As Worksheet Dim Rng As Range Set Sheet1 = Workbooks.Open(TextBox1.Text).Sheets(1) Set Sheet2 = Workbooks.Open(TextBox2.Text).Sheets(1) lastRow = Sheet2.Range("A" & Rows.Count).End(xlUp).Row For i = 2 To lastRow Sheet2.Cells(i, 4).Value = Date Set Rng = Sheet1.Range("A1").CurrentRegion Set Rng = Rng.Offset(1, 0).Resize(Rng.Rows.Count - 1, Rng.Columns.Count) Next Sheet2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize( _ Rng.Rows.Count, Rng.Columns.Count).Value = Rng.Value lastRow = Sheet2.Range("A" & Rows.Count).End(xlUp).Row For i = 2 To lastRow if not cbool(len(Sheet2.Cells(i, 4))) then Sheet2.Cells(i, 4) = Date next i Sheet2.Parent.Close True 'save changes Sheet1.Parent.Close False 'don't save End Sub

I have not tested it, but the idea of the second loop is to add data only if the cell is empty. You can optimize it.

red line if not len(Sheet2.Cells(i, 4) then Sheet2.Cells(i, 4) = Date
it's still red line i dont really know how to debug it @.@

Siddharth Rout · Accepted Answer · 2016-04-04 08:59:35Z

Here is a faster way of doing it

Logic:

Read the text file in memory and store it in an array
Insert date in the 3rd column

Code

Sub Sample() Dim MyData As String, strData() As String Dim TempAr '~~> Read the text file in memory in one go Open "C:\File1.Txt" For Binary As #1 MyData = Space$(LOF(1)) Get #1, , MyData Close #1 strData() = Split(MyData, vbCrLf) For i = LBound(strData) To UBound(strData) TempAr = Split(strData(i), "|") If Len(Trim(TempAr(2))) = 0 Then TempAr(2) = Date strData(i) = Join(TempAr, "|") Debug.Print strData(i) Next i '~~> strData now has all the data from file1 with date in it '~~> Simply append the array to the 2nd text file End Sub

Collectives™ on Stack Overflow

VBA - Insert Current Date in Column

2 Answers 2

5 Comments

Comments

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

5 Comments

Comments

Related