Adding todays date to new records in Excel

M

mikerobe

HI
I hope someone can help. I run Macro in Excel to add new records from
a text file to the bottom of an excel sheet on a daily basis.
Therefore the number of records in the sheet grows daily. There is
data in each column up to column K. I would like to be able to add
todays (being the day the data is added to the sheet) date to Column L
when each new record is added while running the Macro.

Is this possible.

Thanks for any help
Eddie
 
R

Ron de Bruin

Hi Mike

If Rnum is the row number you copy to

This will add the date

Cells(Rnum,"L").Value = Date
 
M

mikerobe

Thanks Mike and Ron

Here is the Macro which I should have included first time

Sub klm()

Workbooks.OpenText Filename:="M:\Statdata\klm.txt",
Origin:=xlMSDOS, _
StartRow:=1, DataType:=xlDelimited,
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False,
Comma:=True _
, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1),
Array(2, 1), _
Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7,
1), Array(8, 1), Array(9, 1), _
Array(10, 1)), TrailingMinusNumbers:=True, Local:=True '<-
this decides date interpretation

Selection.Sort Key1:=Range("H1"), Order1:=xlDescending,
Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom,
_
DataOption1:=xlSortNormal


Rows("1:1").Select
Selection.Insert Shift:=xlDown
Cells.Select
Selection.AutoFilter
Selection.AutoFilter Field:=11, Criteria1:="=STAU"
Sheets.Add
Sheets("klm").Select
Rows("1:6000").Select
Selection.Copy
Sheets("Sheet1").Select
Range("A1").Select
ActiveSheet.Paste


Rows("2:6000").Select
Selection.Copy

Workbooks.Open Filename:= _
"G:\J\klm.xls", Origin:=xlWindows


Range("A65536").End(xlUp).Offset(1, 0).Select

ActiveSheet.Paste

Cells.Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending,
Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom,
_
DataOption1:=xlSortNormal

Columns("A:A").Select


Set Rng = ActiveSheet
R = 1
N = 1
With Rng
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
Do While N <= LastRow
If R Mod 500 = 0 Then
Application.StatusBar = "Processing Row: " & Format(R,
"#,##0")
End If

V = .Range("A" & R).Value

If V = vbNullString Then
If Application.WorksheetFunction. _
CountIf(.Columns(1), vbNullString) > 1 Then


.Rows(R).Delete
End If
Else
Next_V = .Range("A" & (R + 1)).Value
If V = Next_V Then
Thisdate = .Range("H" & R).Value
NextDate = .Range("H" & (R + 1)).Value
If Thisdate < NextDate Then
.Rows(R + 1).Delete
Else
.Rows(R).Delete
End If
Else
R = R + 1
End If
End If
N = N + 1
Loop
End With
Cells.Select
Selection.Sort Key1:=Range("H2"), Order1:=xlAscending,
Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom,
_
DataOption1:=xlSortNormal


ActiveWorkbook.Save


End Sub

Thanks for offering your help

Eddie
 
M

mikerobe

I would think the best time to put the dates is right after you copy the
text to sheet1 in the text file, and before you copy that to your workbook.
Here is a snippet from your code with the lines added to put the Date in
column L as far down as there is data in column K.

Rows("1:1").Select
Selection.Insert Shift:=xlDown
Cells.Select
Selection.AutoFilter
Selection.AutoFilter Field:=11, Criteria1:="=STAU"
Sheets.Add
Sheets("klm").Select
Rows("1:6000").Select
Selection.Copy
Sheets("Sheet1").Select
Range("A1").Select
ActiveSheet.Paste
Range("L1").Value = Date
Range("L1", Range("K1").End(xlDown)).Offset(0, 1).FillDown


Thanks Mike and Ron

Here is the Macro which I should have included first time

Sub klm()

Workbooks.OpenText Filename:="M:\Statdata\klm.txt",
Origin:=xlMSDOS, _
StartRow:=1, DataType:=xlDelimited,
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False,
Comma:=True _
, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1),
Array(2, 1), _
Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7,
1), Array(8, 1), Array(9, 1), _
Array(10, 1)), TrailingMinusNumbers:=True, Local:=True '<-
this decides date interpretation

Selection.Sort Key1:=Range("H1"), Order1:=xlDescending,
Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom,
_
DataOption1:=xlSortNormal

Rows("1:1").Select
Selection.Insert Shift:=xlDown
Cells.Select
Selection.AutoFilter
Selection.AutoFilter Field:=11, Criteria1:="=STAU"
Sheets.Add
Sheets("klm").Select
Rows("1:6000").Select
Selection.Copy
Sheets("Sheet1").Select
Range("A1").Select
ActiveSheet.Paste

Rows("2:6000").Select
Selection.Copy

Workbooks.Open Filename:= _
"G:\J\klm.xls", Origin:=xlWindows

Range("A65536").End(xlUp).Offset(1, 0).Select

ActiveSheet.Paste

Cells.Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending,
Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom,
_
DataOption1:=xlSortNormal

Columns("A:A").Select

Set Rng = ActiveSheet
R = 1
N = 1
With Rng
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
Do While N <= LastRow
If R Mod 500 = 0 Then
Application.StatusBar = "Processing Row: " & Format(R,
"#,##0")
End If

V = .Range("A" & R).Value

If V = vbNullString Then
If Application.WorksheetFunction. _
CountIf(.Columns(1), vbNullString) > 1 Then

.Rows(R).Delete
End If
Else
Next_V = .Range("A" & (R + 1)).Value
If V = Next_V Then
Thisdate = .Range("H" & R).Value
NextDate = .Range("H" & (R + 1)).Value
If Thisdate < NextDate Then
.Rows(R + 1).Delete
Else
.Rows(R).Delete
End If
Else
R = R + 1
End If
End If
N = N + 1
Loop
End With
Cells.Select
Selection.Sort Key1:=Range("H2"), Order1:=xlAscending,
Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom,
_
DataOption1:=xlSortNormal

ActiveWorkbook.Save

End Sub

Thanks for offering your help

Eddie
Click to expand...

Thanks Mike
I will give that a go on Monday and tell you how i get on
Eddie
 
M

mikerobe

I would think the best time to put the dates is right after you copy the
text to sheet1 in the text file, and before you copy that to your workbook..
Here is a snippet from your code with the lines added to put the Date in
column L as far down as there is data in column K.

 Rows("1:1").Select
    Selection.Insert Shift:=xlDown
    Cells.Select
    Selection.AutoFilter
    Selection.AutoFilter Field:=11, Criteria1:="=STAU"
    Sheets.Add
    Sheets("klm").Select
    Rows("1:6000").Select
    Selection.Copy
    Sheets("Sheet1").Select
    Range("A1").Select
    ActiveSheet.Paste
Range("L1").Value = Date
Range("L1", Range("K1").End(xlDown)).Offset(0, 1).FillDown


Thanks Mike and Ron

Here is the Macro which I should have included first time

Sub klm()

    Workbooks.OpenText Filename:="M:\Statdata\klm.txt",
Origin:=xlMSDOS, _
        StartRow:=1, DataType:=xlDelimited,
TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False,
Comma:=True _
        , Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1),
Array(2, 1), _
        Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7,
1), Array(8, 1), Array(9, 1), _
        Array(10, 1)), TrailingMinusNumbers:=True, Local:=True  '<-
this decides date interpretation

    Selection.Sort Key1:=Range("H1"), Order1:=xlDescending,
Header:=xlNo, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom,
_
        DataOption1:=xlSortNormal

    Rows("1:1").Select
    Selection.Insert Shift:=xlDown
    Cells.Select
    Selection.AutoFilter
    Selection.AutoFilter Field:=11, Criteria1:="=STAU"
    Sheets.Add
    Sheets("klm").Select
    Rows("1:6000").Select
    Selection.Copy
    Sheets("Sheet1").Select
    Range("A1").Select
    ActiveSheet.Paste

Rows("2:6000").Select
    Selection.Copy

    Workbooks.Open Filename:= _
        "G:\J\klm.xls", Origin:=xlWindows

Range("A65536").End(xlUp).Offset(1, 0).Select

ActiveSheet.Paste

    Cells.Select
    Selection.Sort Key1:=Range("A2"), Order1:=xlAscending,
Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom,
_
        DataOption1:=xlSortNormal

    Columns("A:A").Select

   Set Rng = ActiveSheet
R = 1
N = 1
With Rng
   LastRow = .Range("A" & Rows.Count).End(xlUp).Row
   Do While N <= LastRow
      If R Mod 500 = 0 Then
         Application.StatusBar = "Processing Row: " & Format(R,
"#,##0")
      End If

      V = .Range("A" & R).Value

      If V = vbNullString Then
         If Application.WorksheetFunction. _
            CountIf(.Columns(1), vbNullString) > 1 Then

            .Rows(R).Delete
         End If
      Else
         Next_V = .Range("A" & (R + 1)).Value
         If V = Next_V Then
            Thisdate = .Range("H" & R).Value
            NextDate = .Range("H" & (R + 1)).Value
            If Thisdate < NextDate Then
               .Rows(R + 1).Delete
            Else
               .Rows(R).Delete
            End If
         Else
            R = R + 1
         End If
      End If
      N = N + 1
   Loop
End With
Cells.Select
    Selection.Sort Key1:=Range("H2"), Order1:=xlAscending,
Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom,
_
        DataOption1:=xlSortNormal

ActiveWorkbook.Save

End Sub

Thanks for offering your help

Eddie





- Show quoted text -
Click to expand...

Hi Mike
This isn't quite working as i hoped. the date is only added to the
last record that was added to the worksheet. Ultimately why i need to
add the date is to use this date to extract data from multiple
worksheets in the same folder to one worksheet in a separate workbook.
The original text file is data from a Healthcare patient search. The
dates queried go back 2 weeks in case the extract new record macro is
not run daily as it normally should be.

Hope this is clear

Thanks
Eddie
 
M

mikerobe

Hi Mike
This isn't quite working as i hoped. the date is only added to the
last record that was added to the worksheet. Ultimately why i need to
add the date is to use this date to extract data from multiple
worksheets in the same folder to one worksheet in a separate workbook.
The original text file is data from a Healthcare patient search. The
dates queried go back 2 weeks in case the extract new record macro is
not run daily as it normally should be.

Hope this is clear

Thanks
Eddie- Hide quoted text -

- Show quoted text -
Click to expand...

Hi Mike
I have thought of another possible way around this. I can extract
todays date with the text file. It will be positioned on Column H
moving the sample date to Column I. This works fine but when the query
is run on the next day the dates (in the todays date column) get
overwritten with the next days date. Is there a way of locking these
dates so they are not overwritten.

Thanks
Eddie
 
M

mikerobe

Not really. First of all the two lines I added should put the date in column
L as far down as there is data in column K. This is done in the helper sheet
you added to the text file. Did this not happen? Step through the code line
by line and tell me what happened when you got past my lines.


















Hi Mike
This isn't quite working as i hoped. the date is only added to the
last record that was added to the worksheet. Ultimately why i need to
add the date is to use this date to extract data from multiple
worksheets in the same folder to one worksheet in a separate workbook.
The original text file is data from a Healthcare patient search. The
dates queried go back 2 weeks in case the extract new record macro is
not run daily as it normally should be.

Hope this is clear

Thanks
Eddie- Hide quoted text -

- Show quoted text -
Click to expand...

Hi again Mike
Stepped through the macro and still a little confused. I have now
slightly changed tack. I can extract now todays date with the text
file. It will be positioned on Column H moving the sample date to
Column I. If I could include in the Macro possible an If Then
statement during importation from the helper sheet. Say If the date in
Column H is greater than the existing date in the column do not paste
the data this would stop the overwriting I think

Thanks
Eddie
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Todays date minus 1 4
Adding date to a column in Excel 5
Return to todays date macro 4
Add new sheet automatically every data. 1
How to copy one column values to another column based on conditionthat row2 contain todays date 4
Transfer data between two worksheets 10
Set DTPickers Data to Todays Date by Default 1
Data need to be copied as per sheet name 4

Top