Ken wrote:
--
Ken living downunder


"Ken Johnson" wrote:

Ken wrote:
I enter data into a spreadsheet on a daily basis and keep a sequential record
of this data.

Rather than copy and paste to build up this historical data base I need a
macro that changes the cell address as new data is entered. This new address
is the next line down in sequence for storing this historical information.

In other words if the last address was C55 after running the macro the next
address would be C56 thence C57 if it is run again. So every time the macro
is run it sequentially directs the data being stored into the next line.

I have used the Find function to get the first line for data storage but
rather than just searching for a key word it remembers the original cell
address and will not allow sequential recording to occur. What I need is to
be able to change the cell address within the macro so future data can be
stored in subsequent cells.

Any assistance would be appreciated
--
Ken living downunder

Hi Ken,

Do you mean something like this...

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A1")) Is Nothing Then
If Cells(Rows.Count, 1).End(xlUp).Row = 1 _
And Range("A2") < "" Then
MsgBox "You have reached the bottom of the sheet!"
Exit Sub
End If
Application.EnableEvents = False
On Error GoTo ERRORHANDLER
Dim rngOld As Range, rngNew As Range
Set rngOld = Range(Cells(1, 1), _
Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1))
Set rngNew = rngOld.Offset(1, 0)
rngNew.Value = rngOld.Value
With Range("A1")
.ClearContents
.Select
End With
Application.EnableEvents = True
End If
Exit Sub
ERRORHANDLER: Application.EnableEvents = True
End Sub


It's an event procedure.
It's set up for A1 and could easily be modified to work on any cell.
When new data is entered into A1 it is immediately moved to A2. Also,
all cells (with data) below A1 are moved down as well.

To get the code in place...

1. Copy it
2. Right click the sheet tab then select "View Code" from the popup
menu.
3. Paste the code into the worksheet's code module.
4. Press Alt + F11 to get back to Excel's user interface.

The code will only work if your Security setting is "Medium". If this
is not the case then...

1. Go Tools|Macro|Security...then click on Medium then click OK
2. Close the workbook then reopen it.
3. Click "Enable Macros" on the "Security Warning" dialog. Everytime
the workbook is opened you must click "Enable Macros".

Ken Johnson

Hi Ken

Thanks for your help. I will be leaving today (Christmas eve down here) with
my wife to spend Christmas with our son and grand children who live in
Brisbane.

Will try on my return. Have an enjoyable Christmas and New Year

Many thanks

Ken Pearson

Hi Ken,

I hope Brisbane wasn't too hot and muggy.

Version 3 enables you to have more than one input cell on the sheet.
Just edit the address string in the line...

Dim rngInput As Range: Set rngInput = Range("B3,D3,F3")

As it stands, B3, D3 and F3 are input cells. If you wanted the first
four cells in the second row to be input cells you would change the
address string to "A2:D2".

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo ERRORHANDLER
'Change the address string below to suit your needs
Dim rngInput As Range: Set rngInput = Range("B3,D3,F3") '<<<
If Not Intersect(Target, rngInput) Is Nothing Then
Application.ScreenUpdating = False
Dim rngCell As Range
For Each rngCell In Intersect(Target, rngInput)
If Cells(Rows.Count, rngCell.Column).End(xlUp).Row = _
rngCell.Row And rngCell.Offset(1, 0).Value < "" Then
MsgBox "You have reached the bottom of the sheet" _
& vbNewLine & "in column " _
& Mid(rngCell.Address, 2, _
WorksheetFunction.Find("$", rngCell.Address, 2) - 2)
GoTo NEXT_rngCell
End If
Application.EnableEvents = False
Dim rngOld As Range, rngNew As Range
Set rngOld = Range(rngCell, Cells(Cells(Rows.Count, _
rngCell.Column).End(xlUp).Row, rngCell.Column))
Set rngNew = rngOld.Offset(1, 0)
rngNew.Value = rngOld.Value
With rngCell
.ClearContents
.Select
End With
NEXT_rngCell: Next rngCell
Application.EnableEvents = True
End If
Exit Sub
ERRORHANDLER: Application.EnableEvents = True
Me.Protect
End Sub

Ken Johnson