The Tamer
01-25-2005, 02:15 AM
Can someone please have a look at this code and tell me why Dr Watson shuts me down every now and again?
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cel As Range
Application.ScreenUpdating = False
For Each Cel In Target
If Cel.Column <> 14 Then
GoTo Line2
Else
GoTo Line1
End If
Line1:
On Error Resume Next
ActiveCell.Offset(0, -4).Activate
ActiveWindow.LargeScroll ToRight:=-1
Line2:
If Cel.Column <> 4 Then GoTo Line3
If Cel.Offset(, -3) <> "" Or _
Cel.Offset(, -2) <> "" Or _
Cel.Offset(, -1) <> "" Or _
Cel.Cells.Count > 1 Or _
Cel.Value = "" Then
Exit Sub
End If
Cel.Offset(, -3).Value = Cel.Offset(-1, -3).FormulaR1C1
Cel.Offset(, -2).Value = Cel.Offset(-1, -2).FormulaR1C1
Cel.Offset(, -1).Value = Cel.Offset(-1, -1).FormulaR1C1
Line3:
If Cel.Column <> 10 Then Exit Sub
If Cel.Offset(, -9) <> "" Or _
Cel.Offset(, -8) <> "" Or _
Cel.Offset(, -7) <> "" Or _
Cel.Offset(, -6) <> "" Or _
Cel.Offset(, -5) <> "" Or _
Cel.Offset(, -4) <> "" Or _
Cel.Offset(, -3) <> "" Or _
Cel.Offset(, -2) <> "" Or _
Cel.Offset(, -1) <> "" Or _
Cel.Cells.Count > 1 Or _
Cel.Value = "" Then
Exit Sub
End If
Cel.Offset(, -9).Value = Cel.Offset(-1, -9).FormulaR1C1
Cel.Offset(, -8).Value = Cel.Offset(-1, -8).FormulaR1C1
Cel.Offset(, -7).Value = Cel.Offset(-1, -7).FormulaR1C1
Cel.Offset(, -6).Value = Cel.Offset(-1, -6).Value
Cel.Offset(, -5).Value = Cel.Offset(-1, -5).Value
Cel.Offset(, -4).Value = Cel.Offset(-1, -4).Value
Cel.Offset(, -3).Value = Cel.Offset(-1, -3).Value
Cel.Offset(, -2).Value = Cel.Offset(-1, -2).Value
Cel.Offset(, -1).Value = Cel.Offset(-1, -1).Value
Cel.Offset(, 1).Value = Cel.Offset(-1, 1).Value
Cel.Offset(, 2).Value = Cel.Offset(-1, 2).Value
Cel.Offset(, 3).Value = Cel.Offset(-1, 3).Value
Cel.Offset(, 4).Value = Cel.Offset(-1, 4).Value
Next
If Target.Cells.Count = 1 Then
Range("J65536").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Activate
Exit Sub
Else
Application.ScreenUpdating = True
Range("J65536").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Activate
MsgBox "The names have been copied, but the grades, department and other
delegate details may need to be changed. please check"
Application.CutCopyMode = False
End If
End Sub
The idea of the code is that it copies the info in the line above, provided that there is not already info elsewhere in the current line. This is only meant to happen when the user puts something in columns D or J. The code also returns the active cell to column J of the next row down when the user completes the cell in column N.
I'm still a young novice when it comes to code - and this code does work usually. But Excel also crashes far more often than usual when this wb is being used.
I really would appreciate a hand tidying it up.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cel As Range
Application.ScreenUpdating = False
For Each Cel In Target
If Cel.Column <> 14 Then
GoTo Line2
Else
GoTo Line1
End If
Line1:
On Error Resume Next
ActiveCell.Offset(0, -4).Activate
ActiveWindow.LargeScroll ToRight:=-1
Line2:
If Cel.Column <> 4 Then GoTo Line3
If Cel.Offset(, -3) <> "" Or _
Cel.Offset(, -2) <> "" Or _
Cel.Offset(, -1) <> "" Or _
Cel.Cells.Count > 1 Or _
Cel.Value = "" Then
Exit Sub
End If
Cel.Offset(, -3).Value = Cel.Offset(-1, -3).FormulaR1C1
Cel.Offset(, -2).Value = Cel.Offset(-1, -2).FormulaR1C1
Cel.Offset(, -1).Value = Cel.Offset(-1, -1).FormulaR1C1
Line3:
If Cel.Column <> 10 Then Exit Sub
If Cel.Offset(, -9) <> "" Or _
Cel.Offset(, -8) <> "" Or _
Cel.Offset(, -7) <> "" Or _
Cel.Offset(, -6) <> "" Or _
Cel.Offset(, -5) <> "" Or _
Cel.Offset(, -4) <> "" Or _
Cel.Offset(, -3) <> "" Or _
Cel.Offset(, -2) <> "" Or _
Cel.Offset(, -1) <> "" Or _
Cel.Cells.Count > 1 Or _
Cel.Value = "" Then
Exit Sub
End If
Cel.Offset(, -9).Value = Cel.Offset(-1, -9).FormulaR1C1
Cel.Offset(, -8).Value = Cel.Offset(-1, -8).FormulaR1C1
Cel.Offset(, -7).Value = Cel.Offset(-1, -7).FormulaR1C1
Cel.Offset(, -6).Value = Cel.Offset(-1, -6).Value
Cel.Offset(, -5).Value = Cel.Offset(-1, -5).Value
Cel.Offset(, -4).Value = Cel.Offset(-1, -4).Value
Cel.Offset(, -3).Value = Cel.Offset(-1, -3).Value
Cel.Offset(, -2).Value = Cel.Offset(-1, -2).Value
Cel.Offset(, -1).Value = Cel.Offset(-1, -1).Value
Cel.Offset(, 1).Value = Cel.Offset(-1, 1).Value
Cel.Offset(, 2).Value = Cel.Offset(-1, 2).Value
Cel.Offset(, 3).Value = Cel.Offset(-1, 3).Value
Cel.Offset(, 4).Value = Cel.Offset(-1, 4).Value
Next
If Target.Cells.Count = 1 Then
Range("J65536").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Activate
Exit Sub
Else
Application.ScreenUpdating = True
Range("J65536").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Activate
MsgBox "The names have been copied, but the grades, department and other
delegate details may need to be changed. please check"
Application.CutCopyMode = False
End If
End Sub
The idea of the code is that it copies the info in the line above, provided that there is not already info elsewhere in the current line. This is only meant to happen when the user puts something in columns D or J. The code also returns the active cell to column J of the next row down when the user completes the cell in column N.
I'm still a young novice when it comes to code - and this code does work usually. But Excel also crashes far more often than usual when this wb is being used.
I really would appreciate a hand tidying it up.