VBA Code to Automatically move text into above cells?

[mj_bowen]

I have (with the help of some of the very talented Excel MVP’s) nearly
finished a to do list spread sheet!

http://www.box.net/shared/ejzn141dux

The worksheet works like this:
Enter desired text in cell c3 and then use the drop down button in b3 to
determine the position where the text is to be placed in the below list. If
there is text already in that position all the text below is moved down one
cell. This part of it works fine.

Three lists can be managed this way – Home, Work and Other.

However, I would like to be able to delete the text from a cell by using the
backspace button. For example if I deleted the text in C9 (Go Shopping) all
the text in the cells below would be moved up one –ie, Hoover Lounge would
move up to C9 and Pay Milkman to C10 etc. I would like to be able to do this
for all three lists – (which have 100 positions each as the range), but am
not sure how to adapt/add to the already existing VBA code. I have tried, but
am out of my depth.

Yours sincerely,

Matt – a hopefully organised infant school teacher in 2010!

 

[Don Guillett]

with the help of some ??? Just call me "some" from now on.
Since I am the one who wrote the original code and I don't see any other
code, I will answer the follow up. I notice you were shading the text cell
which shaded the destination cell so I also fixed that.

=
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range) 'SAS
Application.ScreenUpdating = False
If Not Intersect(Target, Range("b3,g3,l3")) Is Nothing Then
If Len(Application.Trim(Target.Offset(, 1))) < 1 Then Exit Sub

With Cells(Target + 5, Target.Column + 1)
If Len(Application.Trim(.Value)) < 1 Then
.Value = Target.Offset(, 1).Value
Else
Target.Offset(, 1).Copy
.Insert Shift:=xlDown
.Offset(-1).Interior.ColorIndex = 0
End If
End With
Application.CutCopyMode = False
End If
'delete
If Not Intersect(Target, Range("c6:c45,h6:h45,m6:m45")) Is Nothing Then
Application.EnableEvents = False
If Len(Application.Trim(Target)) < 1 Then Target.Delete Shift:=xlUp
Application.EnableEvents = True
End If
Application.ScreenUpdating = True
End Sub
==

 

[JLatham]

Can we call you SUM() for short?

Since I am the one who wrote the original code and I don't see any other
code, I will answer the follow up. I notice you were shading the text cell
which shaded the destination cell so I also fixed that.

=
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range) 'SAS
Application.ScreenUpdating = False
If Not Intersect(Target, Range("b3,g3,l3")) Is Nothing Then
If Len(Application.Trim(Target.Offset(, 1))) < 1 Then Exit Sub

With Cells(Target + 5, Target.Column + 1)
If Len(Application.Trim(.Value)) < 1 Then
.Value = Target.Offset(, 1).Value
Else
Target.Offset(, 1).Copy
.Insert Shift:=xlDown
.Offset(-1).Interior.ColorIndex = 0
End If
End With
Application.CutCopyMode = False
End If
'delete
If Not Intersect(Target, Range("c6:c45,h6:h45,m6:m45")) Is Nothing Then
Application.EnableEvents = False
If Len(Application.Trim(Target)) < 1 Then Target.Delete Shift:=xlUp
Application.EnableEvents = True
End If
Application.ScreenUpdating = True
End Sub
==


--
Don Guillett
Microsoft MVP Excel
SalesAid Software
(e-mail address removed)


.

 

[mj_bowen]

Thank you once again Don - Sorry about the "Some" incident, I didn't know if
it was wise to mention names as I had previously posted on another forum only
to be told off by the forum police!

It works like a charm!

Happy New Year!

Don Rules!

Matt