--
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

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

Ken Johnson wrote:
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

Hi Ken,

Oops! I was fooling around with Sheet Protection at some stage then I
neglected to remove all of that part of the code before posting Version
3, so use this instead, or just delete the second last line
(Me.Protect)...

Private Sub Worksheet_Change(ByVal Target As Range)
'Change the address string below to suit your needs
On Error GoTo ERRORHANDLER
Dim rngInput As Range: Set rngInput = Range("A1:D1") '<<<
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
End Sub

Ken Johnson

Hi Ken,

I've been looking at how others achieve the same effect and have
discovered it's a lot easier than I thought. It turns out that all that
is needed to shift all of the old data cells down one row is .Insert
Shift:= xlDown.

Also, the way that I was checking that there was still space on the
sheet for moving the data down one more row was logically flawed, so
I've fixed that up too. The logically correct way also turned out to be
a lot simpler than I originally thought.

So, hopefully my final version is...

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Dim rngInput As Range
Dim rngCell As Range
Set rngInput = Range("A2") '<<<<<<<<<<<<<<<<<<<<<<
'Edit rngInput's Address String to suit your needs^
'Examples...
' "A2,C2" for A2 and C2
' "D1:G1" for D1, E1, F1 and G1
' "A2,C2,D1:G1" for A2, C2, D1, E1, F1 and G1.
If Not Intersect(Target, rngInput) Is Nothing Then
On Error GoTo ERRORHANDLER
Application.EnableEvents = False
For Each rngCell In Intersect(Target, rngInput)
If rngCell.Value < "" Then
If Cells(Rows.Count, _
rngCell.Column).Value = "" Then
rngCell.Insert shift:=xlDown
With rngCell.Offset(-1, 0)
.ClearContents
.Select
End With
Else: MsgBox "No more room in column " _
& Mid(rngCell.Address, 2, _
WorksheetFunction.Find( _
"$", rngCell.Address, 2) - 2)
End If
End If
Next rngCell
Application.EnableEvents = True
End If
Exit Sub
ERRORHANDLER: Application.EnableEvents = True
End Sub


Ken Johnson