VBA - Insert Current Date in Column - vba

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

Answer 1

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.

Answer 2

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