Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Dim row_num As Integer
Dim InitialSheetName As String
Dim FinalSheetName As String
InitialSheetName = "Initial"
FinalSheetName = "Final"
CharacterToLookFor = "X"
' The variable KeyCells contains the cells that will
' cause an alert when they are changed.
Set KeyCells = Range("A:C")
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
' Display a message when one of the designated cells has been
' changed.
' Place your code here.
row_num = Target.row
If InStr(1, ActiveSheet.Range("A" & row_num).Value, CharacterToLookFor) > 0 Then
If InStr(1, ActiveSheet.Range("B" & row_num).Value, CharacterToLookFor) > 0 Then
If InStr(1, ActiveSheet.Range("C" & row_num).Value, CharacterToLookFor) > 0 Then
ActiveSheet.Rows(LTrim(Str(Target.row)) & ":" & LTrim(Str(Target.row))).Select
Selection.Copy
Sheets(FinalSheetName).Select
NumberOfRows = ActiveSheet.Range("A65536").End(xlUp).row
ActiveSheet.Range("A" & NumberOfRows + 1).Select
Selection.Insert Shift:=xlDown
Sheets(InitialSheetName).Select
ActiveSheet.Rows(LTrim(Str(Target.row)) & ":" & LTrim(Str(Target.row))).Select
Selection.Cells(1).EntireRow.Delete
End If
End If
End If
End If
End Sub
Private Sub SENDTOCOMPLETE(ByVal Target As Range)
Dim KeyCells As Range
Dim row_num As Integer
Dim InitialSheetName As String
Dim FinalSheetName As String
InitialSheetName = "Sheet3"
FinalSheetName = "Sheet4"
CharacterToLookFor = "x"
' The variable KeyCells contains the cells that will
' cause an alert when they are changed.
Set KeyCells = Range("G:I")
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
' Display a message when one of the designated cells has been
' changed.
' Place your code here.
row_num = Target.Row
If InStr(1, ActiveSheet.Range("G" & row_num).Value, CharacterToLookFor) > 0 Then
If InStr(1, ActiveSheet.Range("H" & row_num).Value, CharacterToLookFor) > 0 Then
If InStr(1, ActiveSheet.Range("I" & row_num).Value, CharacterToLookFor) > 0 Then
ActiveSheet.Rows(LTrim(Str(Target.Row)) & ":" & LTrim(Str(Target.Row))).Select
Selection.Copy
Sheets(COMPLETE).Select
NumberOfRows = ActiveSheet.Range("A65536").End(xlUp).Row
ActiveSheet.Range("A" & NumberOfRows + 1).Select
Selection.Insert Shift:=xlDown
Sheets(InitialSheetName).Select
ActiveSheet.Rows(LTrim(Str(Target.Row)) & ":" & LTrim(Str(Target.Row))).Select
Selection.Cells(1).EntireRow.Delete
End If
End If
End If
End If
End Sub
Thanks postmark, finally had a chance to play with it ... this is what I have now:
Is there a way to test it? I closed it, and changed the the tabs to yes, and it doesn't do anything.Code:Private Sub SENDTOCOMPLETE(ByVal Target As Range) Dim KeyCells As Range Dim row_num As Integer Dim InitialSheetName As String Dim FinalSheetName As String InitialSheetName = "Sheet3" FinalSheetName = "Sheet4" CharacterToLookFor = "x" ' The variable KeyCells contains the cells that will ' cause an alert when they are changed. Set KeyCells = Range("G:I") If Not Application.Intersect(KeyCells, Range(Target.Address)) _ Is Nothing Then ' Display a message when one of the designated cells has been ' changed. ' Place your code here. row_num = Target.Row If InStr(1, ActiveSheet.Range("G" & row_num).Value, CharacterToLookFor) > 0 Then If InStr(1, ActiveSheet.Range("H" & row_num).Value, CharacterToLookFor) > 0 Then If InStr(1, ActiveSheet.Range("I" & row_num).Value, CharacterToLookFor) > 0 Then ActiveSheet.Rows(LTrim(Str(Target.Row)) & ":" & LTrim(Str(Target.Row))).Select Selection.Copy Sheets(COMPLETE).Select NumberOfRows = ActiveSheet.Range("A65536").End(xlUp).Row ActiveSheet.Range("A" & NumberOfRows + 1).Select Selection.Insert Shift:=xlDown Sheets(InitialSheetName).Select ActiveSheet.Rows(LTrim(Str(Target.Row)) & ":" & LTrim(Str(Target.Row))).Select Selection.Cells(1).EntireRow.Delete End If End If End If End If End Sub