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

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:

1. Read the text file in memory and store it in an array
2. 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