Anne Troy
06-29-2005, 12:51 PM
Someone near and dear wrote this code, but it doesn't run in 97.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long
Dim LastRow As Long
Dim Cel As Range
If Target.Column = 3 Or Target.Column = 4 Then
LastRow = Range("A65536").End(xlUp).Row
For i = 2 To LastRow
Set Cel = Sheet2.Range("A:A").Find(What:=Range("C" & i).Text, _
LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)
If Cel Is Nothing Then
Range("C" & i).Interior.ColorIndex = xlNone
Else
Range("C" & i).Interior.ColorIndex = _
Sheet2.Range("A" & Cel.Row).Interior.ColorIndex
End If
Next i
For i = 2 To LastRow
Set Cel = Sheet2.Range("B:B").Find(What:=Range("D" & i).Text, _
LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)
If Cel Is Nothing Then
Range("D" & i).Interior.ColorIndex = xlNone
Else
Range("D" & i).Interior.ColorIndex = _
Sheet2.Range("B" & Cel.Row).Interior.ColorIndex
End If
Next i
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Long
Dim LastRow As Long
If Intersect(Target, Range("A1,C1:D1")) Is Nothing Then
Exit Sub
End If
Application.ScreenUpdating = False
Application.EnableEvents = False
Range("C:D").NumberFormat = "@"
LastRow = Sheet2.Range("A65536").End(xlUp).Row
For i = 2 To LastRow
Range("C:C").Replace What:=Sheet2.Range("A" & i).Text, _
Replacement:=Application.WorksheetFunction.Rept("a", i), LookAt:=xlWhole
Next i
LastRow = Sheet2.Range("B65536").End(xlUp).Row
For i = 2 To LastRow
Range("D:D").Replace What:=Sheet2.Range("B" & i).Text, _
Replacement:=Application.WorksheetFunction.Rept("a", i), LookAt:=xlWhole
Next i
Select Case Target.Column
Case Is = 1
Range("sfw").Sort Key1:=Range("A2"), Order1:=xlAscending, _
Key2:=Range("C2"), Order2:=xlAscending, _
Key3:=Range("D2"), Order3:=xlAscending, _
Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, _
DataOption2:=xlSortNormal, DataOption3:=xlSortNormal
Case Is = 3
Range("sfw").Sort Key1:=Range("C2"), Order1:=xlAscending, _
Key2:=Range("A2"), Order2:=xlAscending, _
Key3:=Range("D2"), Order3:=xlAscending, _
Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, _
DataOption2:=xlSortNormal, DataOption3:=xlSortNormal
Case Is = 4
Range("sfw").Sort Key1:=Range("D2"), Order1:=xlAscending, _
Key2:=Range("A2"), Order2:=xlAscending, _
Key3:=Range("C2"), Order3:=xlAscending, _
Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, _
DataOption2:=xlSortNormal, DataOption3:=xlSortNormal
End Select
LastRow = Sheet2.Range("A65536").End(xlUp).Row
For i = 2 To LastRow
Range("C:C").Replace What:=Application.WorksheetFunction.Rept("a", i), _
Replacement:=Sheet2.Range("A" & i).Text, LookAt:=xlWhole
Next i
LastRow = Sheet2.Range("B65536").End(xlUp).Row
For i = 2 To LastRow
Range("D:D").Replace What:=Application.WorksheetFunction.Rept("a", i), _
Replacement:=Sheet2.Range("B" & i).Text, LookAt:=xlWhole
Next i
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long
Dim LastRow As Long
Dim Cel As Range
If Target.Column = 3 Or Target.Column = 4 Then
LastRow = Range("A65536").End(xlUp).Row
For i = 2 To LastRow
Set Cel = Sheet2.Range("A:A").Find(What:=Range("C" & i).Text, _
LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)
If Cel Is Nothing Then
Range("C" & i).Interior.ColorIndex = xlNone
Else
Range("C" & i).Interior.ColorIndex = _
Sheet2.Range("A" & Cel.Row).Interior.ColorIndex
End If
Next i
For i = 2 To LastRow
Set Cel = Sheet2.Range("B:B").Find(What:=Range("D" & i).Text, _
LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)
If Cel Is Nothing Then
Range("D" & i).Interior.ColorIndex = xlNone
Else
Range("D" & i).Interior.ColorIndex = _
Sheet2.Range("B" & Cel.Row).Interior.ColorIndex
End If
Next i
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Long
Dim LastRow As Long
If Intersect(Target, Range("A1,C1:D1")) Is Nothing Then
Exit Sub
End If
Application.ScreenUpdating = False
Application.EnableEvents = False
Range("C:D").NumberFormat = "@"
LastRow = Sheet2.Range("A65536").End(xlUp).Row
For i = 2 To LastRow
Range("C:C").Replace What:=Sheet2.Range("A" & i).Text, _
Replacement:=Application.WorksheetFunction.Rept("a", i), LookAt:=xlWhole
Next i
LastRow = Sheet2.Range("B65536").End(xlUp).Row
For i = 2 To LastRow
Range("D:D").Replace What:=Sheet2.Range("B" & i).Text, _
Replacement:=Application.WorksheetFunction.Rept("a", i), LookAt:=xlWhole
Next i
Select Case Target.Column
Case Is = 1
Range("sfw").Sort Key1:=Range("A2"), Order1:=xlAscending, _
Key2:=Range("C2"), Order2:=xlAscending, _
Key3:=Range("D2"), Order3:=xlAscending, _
Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, _
DataOption2:=xlSortNormal, DataOption3:=xlSortNormal
Case Is = 3
Range("sfw").Sort Key1:=Range("C2"), Order1:=xlAscending, _
Key2:=Range("A2"), Order2:=xlAscending, _
Key3:=Range("D2"), Order3:=xlAscending, _
Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, _
DataOption2:=xlSortNormal, DataOption3:=xlSortNormal
Case Is = 4
Range("sfw").Sort Key1:=Range("D2"), Order1:=xlAscending, _
Key2:=Range("A2"), Order2:=xlAscending, _
Key3:=Range("C2"), Order3:=xlAscending, _
Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, _
DataOption2:=xlSortNormal, DataOption3:=xlSortNormal
End Select
LastRow = Sheet2.Range("A65536").End(xlUp).Row
For i = 2 To LastRow
Range("C:C").Replace What:=Application.WorksheetFunction.Rept("a", i), _
Replacement:=Sheet2.Range("A" & i).Text, LookAt:=xlWhole
Next i
LastRow = Sheet2.Range("B65536").End(xlUp).Row
For i = 2 To LastRow
Range("D:D").Replace What:=Application.WorksheetFunction.Rept("a", i), _
Replacement:=Sheet2.Range("B" & i).Text, LookAt:=xlWhole
Next i
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub