ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   VBA Query (https://www.excelbanter.com/excel-programming/355815-vba-query.html)

missk

VBA Query
 
Hi Pls HELP,

I've got two columns (A & B).

Column B always have items in it (and new items/lines gets updated
every day). This accumulates over a period of time.

Every day I update Column A manually with todays date for all the
current entries.

I need a macro to update Column A automatically with today's date for
the new entries. Is there a way to do this?????

Thanks


NickHK

VBA Query
 
missk,
How does column B get updated ?

NickHK

"missk" wrote in message
oups.com...
Hi Pls HELP,

I've got two columns (A & B).

Column B always have items in it (and new items/lines gets updated
every day). This accumulates over a period of time.

Every day I update Column A manually with todays date for all the
current entries.

I need a macro to update Column A automatically with today's date for
the new entries. Is there a way to do this?????

Thanks




GS

VBA Query
 
Hi missk,

Something like this might work if:

1. column B has no blanks;
2. column A has no blanks except for cells adjacent to today's entries in
column B.

Sub DateAsToday()
Dim lStartRow As Long, lLastRow As Long
Dim c As Range

lStartRow = Range("A1").End(xlDown).Row + 1
lLastRow = Range("B1").End(xlDown).Row

For Each c In Range(Cells(lStartRow, 1), Cells(lLastRow, 1))
c.Value = Date
Next

End Sub


HTH
Regards,
GS

Norman Jones

VBA Query
 
Hi Missk,

Try assigning the following macro to a button:

'=============
Public Sub Tester01()
Dim rng As Range
Dim LRow As Long

LRow = Cells(Rows.Count, "B").End(xlUp).Row

Set rng = Range("A2:A" & LRow).SpecialCells(xlCellTypeBlanks)

rng.Value = Date

End Sub
'<<=============


Alternatively, If you wish column A to be populated dynamically, in response
to entries in column B, try:

'=============
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Dim rCell As Range

Set rng = Intersect(Columns(2), Target)

If Not rng Is Nothing Then
For Each rCell In rng.Cells
With rCell.Offset(0, -1)
If IsEmpty(.Value) Then
If Not IsEmpty(rCell.Value) Then
.Value = Date
End If
End If
End With
Next rCell
End If
End Sub
'<<=============

The latter sub represents worksheet event code and should be pasted into the
worksheets's code module (not a standard module and not the workbook's
ThisWorkbook module):

Right-click the worksheet's tab
Select 'View Code' from the menu and paste the code.
Alt-F11 to return to Excel.


---
Regards,
Norman


"missk" wrote in message
oups.com...
Hi Pls HELP,

I've got two columns (A & B).

Column B always have items in it (and new items/lines gets updated
every day). This accumulates over a period of time.

Every day I update Column A manually with todays date for all the
current entries.

I need a macro to update Column A automatically with today's date for
the new entries. Is there a way to do this?????

Thanks




Norman Jones

VBA Query
 
Hi Missk,

Replace Sub Tester01 wth the following more robust version:

'=============
Public Sub Tester01A()
Dim rng As Range
Dim LRow As Long

LRow = Cells(Rows.Count, "B").End(xlUp).Row

On Error Resume Next
Set rng = Range("A2:A" & LRow).SpecialCells(xlCellTypeBlanks)
On Error GoTo 0

If Not rng Is Nothing Then rng.Value = Date

End Sub
'<<=============


---
Regards,
Norman



"Norman Jones" wrote in message
...
Hi Missk,

Try assigning the following macro to a button:

'=============
Public Sub Tester01()
Dim rng As Range
Dim LRow As Long

LRow = Cells(Rows.Count, "B").End(xlUp).Row

Set rng = Range("A2:A" & LRow).SpecialCells(xlCellTypeBlanks)

rng.Value = Date

End Sub
'<<=============


Alternatively, If you wish column A to be populated dynamically, in
response to entries in column B, try:

'=============
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Dim rCell As Range

Set rng = Intersect(Columns(2), Target)

If Not rng Is Nothing Then
For Each rCell In rng.Cells
With rCell.Offset(0, -1)
If IsEmpty(.Value) Then
If Not IsEmpty(rCell.Value) Then
.Value = Date
End If
End If
End With
Next rCell
End If
End Sub
'<<=============

The latter sub represents worksheet event code and should be pasted into
the worksheets's code module (not a standard module and not the workbook's
ThisWorkbook module):

Right-click the worksheet's tab
Select 'View Code' from the menu and paste the code.
Alt-F11 to return to Excel.


---
Regards,
Norman




GS

VBA Query
 
Hi Norman,

Nice technique with Tester01(). It's very fast on a long list.

The Worksheet_Change idea is probably the way to go.
<FWIW Tester01A() also works in there "as is". -very fast! (Tester01()
raises an error when the cells are filled)

Thanks and regards,
Garry

Norman Jones

VBA Query
 
Hi Garry,

Nice technique with Tester01(). It's very fast on a long list.


Indeed, but it is worth noting that the SpecialCells method is subject to a
potential problem if the number of non contiguous areas exceed 8192:

http://support.microsoft.com/kb/832293/en-us


(Tester01() raises an error when the cells are filled)


That is why I added the error checking and the If Not Rng Is Nothing line.


---
Regards,
Norman


"GS" wrote in message
...
Hi Norman,

Nice technique with Tester01(). It's very fast on a long list.

The Worksheet_Change idea is probably the way to go.
<FWIW Tester01A() also works in there "as is". -very fast! (Tester01()
raises an error when the cells are filled)

Thanks and regards,
Garry




missk

VBA Query
 
thank you sooooooo much everyone.


GS

VBA Query
 
Thanks Norman!

I understand about the SpecialCells method. That's why I went with the For
Each loop. Apples-to-apples, both your Tester()s are faster than my loop.
They don't, however, handle areas properly. That's why your Worksheet_Change
routine does it right, and it's almost as fast when ScreenUpdating is turned
off. That's why I said it's probably the way to go.

Good lesson, ..large thanks!
Regards,
Garry

"Norman Jones" wrote:

Hi Garry,

Nice technique with Tester01(). It's very fast on a long list.


Indeed, but it is worth noting that the SpecialCells method is subject to a
potential problem if the number of non contiguous areas exceed 8192:

http://support.microsoft.com/kb/832293/en-us


(Tester01() raises an error when the cells are filled)


That is why I added the error checking and the If Not Rng Is Nothing line.


---
Regards,
Norman




All times are GMT +1. The time now is 05:16 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com