PDA

View Full Version : [SOLVED] Code Wont' Run in 97



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

Anne Troy
06-29-2005, 12:52 PM
This describes the problem, but darned if I can fix it. :)
http://www.mrexcel.com/archive2/63900/73999.htm

Ken Puls
06-29-2005, 12:58 PM
Hi Anne,

I think that if you run a find/replace on your code, and replace this:


, DataOption1:=xlSortNormal, _
DataOption2:=xlSortNormal, DataOption3:=xlSortNormal

With nothing (blank) it should work... You've got about 3 instances of it in there, but 97 doesn't support those properties.

Ken Puls
06-29-2005, 01:01 PM
Sorry, missed one. OrderCustom has to go as well:


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, MatchCase:=False, _
Orientation:=xlTopToBottom
Case Is = 3
Range("sfw").Sort Key1:=Range("C2"), Order1:=xlAscending, _
Key2:=Range("A2"), Order2:=xlAscending, _
Key3:=Range("D2"), Order3:=xlAscending, _
Header:=xlNo, MatchCase:=False, _
Orientation:=xlTopToBottom
Case Is = 4
Range("sfw").Sort Key1:=Range("D2"), Order1:=xlAscending, _
Key2:=Range("A2"), Order2:=xlAscending, _
Key3:=Range("C2"), Order3:=xlAscending, _
Header:=xlNo, MatchCase:=False, _
Orientation:=xlTopToBottom
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


Let me know,

Anne Troy
06-29-2005, 01:06 PM
Our YIM discussion, LOL.
Ken Puls: posted 2 replies
Dreamboat: THANKS
Ken Puls: Don't thank me till it works!
Ken Puls: lol
Dreamboat: k
Dreamboat: You're the freaking bomb, dude.
Ken Puls: I take it it works?
Dreamboat: ubet
Dreamboat: Thanks a ton.