Run a macro based on the value of a cell

C

Coyote

Hi Everyone

I have what seems to be a simple task but can't seem to figure it out. I
have a excel file that has the tabs "Current User List" & "Prev User List"
On these sheets the first row is called "status" which is either "curr" or
"prev" to indicate employee status. I copied and modified the macro posted
on this site for copying an entire row to another worsheet and it works fine
but I'd like to go one step further. If I change the status of an employee
on the "Current User List" to "Prev" I want the macro to run so that the
record is copied to the "Prev User List automatically.

Any help would be greatly apprciated.
 
C

Coyote

Thanks Frank,
Look at my attached Code In particular the Target.Address. I want this
routine exeuted anytime a change is made to column A regardless of which row
is selected. The code as it stands now will work but only if I select row 2
column A.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address <> "$A2" Then Exit Sub
Dim sourceRange As Range
Dim destrange As Range
Dim Lr As Long
Lr = LastRow(Sheets("Overall List - Prev Users")) + 1
Set sourceRange = ActiveCell.EntireRow
Set destrange = Sheets("Overall List - Prev Users").Rows(Lr)
sourceRange.Copy destrange
sourceRange.EntireRow.Delete

End Sub
Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
 
D

Dave Peterson

I think you have a problem.

You said you wanted it copied if you change the status. You used the
worksheet_selectionchange event. So if you click on another cell or move the
cursor, the code will run.

I think I'd use the worksheet_change event (you're typing the data, right???):

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

Dim SourceRange As Range
Dim DestRange As Range
Dim Lr As Long

'one cell at a time!
If Target.Cells.Count > 1 Then Exit Sub

If Intersect(Target, Me.Range("a:a")) Is Nothing Then Exit Sub

If LCase(Target.Value) <> "prev" Then Exit Sub

Lr = LastRow(Sheets("Overall List - Prev Users")) + 1

Set SourceRange = Target.EntireRow
Set DestRange = Sheets("Overall List - Prev Users").Rows(Lr)

Application.EnableEvents = False
SourceRange.Copy DestRange
SourceRange.EntireRow.Delete
Application.EnableEvents = True

End Sub
 
C

Coyote

Dave,

Thanks this worked perfect.

Dave Peterson said:
I think you have a problem.

You said you wanted it copied if you change the status. You used the
worksheet_selectionchange event. So if you click on another cell or move the
cursor, the code will run.

I think I'd use the worksheet_change event (you're typing the data, right???):

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

Dim SourceRange As Range
Dim DestRange As Range
Dim Lr As Long

'one cell at a time!
If Target.Cells.Count > 1 Then Exit Sub

If Intersect(Target, Me.Range("a:a")) Is Nothing Then Exit Sub

If LCase(Target.Value) <> "prev" Then Exit Sub

Lr = LastRow(Sheets("Overall List - Prev Users")) + 1

Set SourceRange = Target.EntireRow
Set DestRange = Sheets("Overall List - Prev Users").Rows(Lr)

Application.EnableEvents = False
SourceRange.Copy DestRange
SourceRange.EntireRow.Delete
Application.EnableEvents = True

End Sub
Click to expand...
 
Top