georgedaws
03-23-2011, 05:00 AM
Hi,
Courtesy of "mdmackillop" he produced some fine code which works flawlessly.
Private Sub Worksheet_Change(ByVal Target As Range)
Select Case Target.Column
Case 3
Call Macro1(Target)
Case 16
Call Macro2(Target)
Case Else
Call Macro3(Target)
End Select
End Sub
Private Sub Macro1(ByVal Target As Range)
Dim c As Range, i As Long
On Error Resume Next
Set c = Intersect(Target, Columns(3))
If c Is Nothing Then Exit Sub
If IsEmpty(c.Offset(-1, 0)) Or Not IsEmpty(c.Offset(1, 0)) Then Exit Sub
i = c.Row
Application.EnableEvents = False
Range("A" & i - 1 & ":B" & i - 1).Copy Range("A" & i & ":B" & i)
Application.EnableEvents = True
On Error Goto 0
End Sub
Private Sub Macro2(ByVal Target As Range)
Dim c As Range, i As Long
On Error Resume Next
Set c = Intersect(Target, Columns(16))
If c Is Nothing Then Exit Sub
If IsEmpty(c.Offset(-1, 0)) Or Not IsEmpty(c.Offset(1, 0)) Then Exit Sub
i = c.Row
Application.EnableEvents = False
Range("Q" & i - 1).Copy Range("Q" & i) '<===Check this line
Application.EnableEvents = True
On Error Goto 0
End Sub
Private Sub Macro3(ByVal Target As Range)
Const sWSPWD As String = ""
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Me.Range("F3:F10000")) Is Nothing Then
Me.Unprotect ""
If Target.Offset(, 2) = "" Then Target.Offset(, 2) = Date
Me.Protect ""
ElseIf Not Intersect(Target, Me.Range("L3:L10000")) Is Nothing Then
ActiveSheet.Unprotect ""
If Target.Offset(, 1) = "" Then Target.Offset(, 1) = Date
ActiveSheet.Protect ""
ElseIf Not Intersect(Target, Me.Range("O3:O10000")) Is Nothing Then
ActiveSheet.Unprotect ""
If Target.Offset(, 1) = "" Then Target.Offset(, 1) = Date
ActiveSheet.Protect ""
ElseIf Not Intersect(Target, Me.Range("T3:T10000")) Is Nothing Then
ActiveSheet.Unprotect ""
If Target.Offset(, 1) = "" Then Target.Offset(, 1) = Date
ActiveSheet.Protect ""
End If
End Sub
I can see what happens and how the macros are called. However, I want to add conditional formatting with four criteria to column "Q". I have code but I cannot see how I can add to the existing macro list as they allude to columns and this code below alludes to a range
Private Sub Worksheet_Change(ByVal Target As Range)
Dim icolor As Integer
If Not Intersect(Target, Range("A1:A10")) is Nothing Then
Select Case Target
Case 1 To 6
icolor = 4
Case 7 To 10
icolor = 45
Case 11 To 1000000000000
icolor = 3
Case Else
'Whatever
End Select
Target.Interior.ColorIndex = icolor
End If
End Sub
Basically a red, amber, green, or no fill. With no number at all, no cell colour change, 0-6 green 7-10 amber 11+ red.
Any guidance much appreciated.
Thank you.
Courtesy of "mdmackillop" he produced some fine code which works flawlessly.
Private Sub Worksheet_Change(ByVal Target As Range)
Select Case Target.Column
Case 3
Call Macro1(Target)
Case 16
Call Macro2(Target)
Case Else
Call Macro3(Target)
End Select
End Sub
Private Sub Macro1(ByVal Target As Range)
Dim c As Range, i As Long
On Error Resume Next
Set c = Intersect(Target, Columns(3))
If c Is Nothing Then Exit Sub
If IsEmpty(c.Offset(-1, 0)) Or Not IsEmpty(c.Offset(1, 0)) Then Exit Sub
i = c.Row
Application.EnableEvents = False
Range("A" & i - 1 & ":B" & i - 1).Copy Range("A" & i & ":B" & i)
Application.EnableEvents = True
On Error Goto 0
End Sub
Private Sub Macro2(ByVal Target As Range)
Dim c As Range, i As Long
On Error Resume Next
Set c = Intersect(Target, Columns(16))
If c Is Nothing Then Exit Sub
If IsEmpty(c.Offset(-1, 0)) Or Not IsEmpty(c.Offset(1, 0)) Then Exit Sub
i = c.Row
Application.EnableEvents = False
Range("Q" & i - 1).Copy Range("Q" & i) '<===Check this line
Application.EnableEvents = True
On Error Goto 0
End Sub
Private Sub Macro3(ByVal Target As Range)
Const sWSPWD As String = ""
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Me.Range("F3:F10000")) Is Nothing Then
Me.Unprotect ""
If Target.Offset(, 2) = "" Then Target.Offset(, 2) = Date
Me.Protect ""
ElseIf Not Intersect(Target, Me.Range("L3:L10000")) Is Nothing Then
ActiveSheet.Unprotect ""
If Target.Offset(, 1) = "" Then Target.Offset(, 1) = Date
ActiveSheet.Protect ""
ElseIf Not Intersect(Target, Me.Range("O3:O10000")) Is Nothing Then
ActiveSheet.Unprotect ""
If Target.Offset(, 1) = "" Then Target.Offset(, 1) = Date
ActiveSheet.Protect ""
ElseIf Not Intersect(Target, Me.Range("T3:T10000")) Is Nothing Then
ActiveSheet.Unprotect ""
If Target.Offset(, 1) = "" Then Target.Offset(, 1) = Date
ActiveSheet.Protect ""
End If
End Sub
I can see what happens and how the macros are called. However, I want to add conditional formatting with four criteria to column "Q". I have code but I cannot see how I can add to the existing macro list as they allude to columns and this code below alludes to a range
Private Sub Worksheet_Change(ByVal Target As Range)
Dim icolor As Integer
If Not Intersect(Target, Range("A1:A10")) is Nothing Then
Select Case Target
Case 1 To 6
icolor = 4
Case 7 To 10
icolor = 45
Case 11 To 1000000000000
icolor = 3
Case Else
'Whatever
End Select
Target.Interior.ColorIndex = icolor
End If
End Sub
Basically a red, amber, green, or no fill. With no number at all, no cell colour change, 0-6 green 7-10 amber 11+ red.
Any guidance much appreciated.
Thank you.