awagdarikar
Board Regular
- Joined
- Jun 20, 2008
- Messages
- 115
<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o>Hi,</o>
<o></o>
<o>I have recorded a VB Code to port data from one sheet named Job Tracking Matrix to the other sheet named RGB Daily News. This code ran perfectly till now but it is now resulting in hanging up my PC right now. The code goes like this,</o>
<o><?xml:namespace prefix = v ns = "urn:schemas-microsoft-com:vml" /><v:rect id=_x0000_s1026 style="MARGIN-TOP: 5.25pt; Z-INDEX: 1; MARGIN-LEFT: 0px; WIDTH: 405pt; POSITION: absolute; HEIGHT: 477.75pt" filled="f"></v:rect></o>
<o>
' RGB_DAILY_NEWs Macro
'<o></o>
' Macro recorded 7/10/2008 by TE300<o></o>
'<o></o>
'Clean the Sheet RGB_DAILY_NEWs before entry of data through Advance Filter
Sheets("RGB DAILY NEWs").Select
Range("A10:M10").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Interior.ColorIndex = xlNone
Selection.ClearContents<o></o>
'Apply Advance Filter and port data to this sheet RGB_DAILY_NEWs
Range("A9:M65536").Select
Sheets("Job Tracking").Range("A15:AX65536").AdvancedFilter Action:= _
xlFilterCopy, CriteriaRange:=Sheets("Job Tracking").Range("A8:AX9"), _
CopyToRange:=Range("A9:M65536"), Unique:=False
Range("A1").Select
Range("C10").Select
ActiveWindow.FreezePanes = True
Sheets("RGB DAILY NEWs").Select
'Color the rows in RGB_DAILY_NEWs
Dim Y As Long, Ycol As Integer
For Y = 10 To 500
<?xml:namespace prefix = st1 ns = "urn:schemas-microsoft-comffice:smarttags" /><st1lace w:st="on"><st1:PlaceName w:st="on">Select</st1:PlaceName> <st1:PlaceName w:st="on">Case</st1:PlaceName> <st1:PlaceType w:st="on">Range</st1:PlaceType></st1lace>("M" & Y).Value
Case 5
Ycol = 8
Case 6, 7, 8
Ycol = 39
Case 9
Ycol = 6
Case 10
Ycol = 4
Case Else
Ycol = xlNone
End Select
Range("A" & Y & ":L" & Y).Interior.ColorIndex = Ycol
Next Y<o></o>
End Sub<o></o>
<o> </o>
<o></o>
<o>The PC hangs at step </o>
<o></o>
<o>Sheets("Job Tracking").Range("A15:AX65536").AdvancedFilter Action:= _
xlFilterCopy, CriteriaRange:=Sheets("Job Tracking").Range("A8:AX9"), _
CopyToRange:=Range("A9:M65536"), Unique:=False</o>
<o> </o>
<o></o><o>Can somebody help me out?</o>
<o></o>
<o>Thanks in advance,</o>
<o></o>
<o>awagdarikar</o>
<o></o>
<o></o></o>
<o></o>
<o>I have recorded a VB Code to port data from one sheet named Job Tracking Matrix to the other sheet named RGB Daily News. This code ran perfectly till now but it is now resulting in hanging up my PC right now. The code goes like this,</o>
<o><?xml:namespace prefix = v ns = "urn:schemas-microsoft-com:vml" /><v:rect id=_x0000_s1026 style="MARGIN-TOP: 5.25pt; Z-INDEX: 1; MARGIN-LEFT: 0px; WIDTH: 405pt; POSITION: absolute; HEIGHT: 477.75pt" filled="f"></v:rect></o>
<o>
' RGB_DAILY_NEWs Macro
'<o></o>
' Macro recorded 7/10/2008 by TE300<o></o>
'<o></o>
'Clean the Sheet RGB_DAILY_NEWs before entry of data through Advance Filter
Sheets("RGB DAILY NEWs").Select
Range("A10:M10").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Interior.ColorIndex = xlNone
Selection.ClearContents<o></o>
'Apply Advance Filter and port data to this sheet RGB_DAILY_NEWs
Range("A9:M65536").Select
Sheets("Job Tracking").Range("A15:AX65536").AdvancedFilter Action:= _
xlFilterCopy, CriteriaRange:=Sheets("Job Tracking").Range("A8:AX9"), _
CopyToRange:=Range("A9:M65536"), Unique:=False
Range("A1").Select
Range("C10").Select
ActiveWindow.FreezePanes = True
Sheets("RGB DAILY NEWs").Select
'Color the rows in RGB_DAILY_NEWs
Dim Y As Long, Ycol As Integer
For Y = 10 To 500
<?xml:namespace prefix = st1 ns = "urn:schemas-microsoft-comffice:smarttags" /><st1lace w:st="on"><st1:PlaceName w:st="on">Select</st1:PlaceName> <st1:PlaceName w:st="on">Case</st1:PlaceName> <st1:PlaceType w:st="on">Range</st1:PlaceType></st1lace>("M" & Y).Value
Case 5
Ycol = 8
Case 6, 7, 8
Ycol = 39
Case 9
Ycol = 6
Case 10
Ycol = 4
Case Else
Ycol = xlNone
End Select
Range("A" & Y & ":L" & Y).Interior.ColorIndex = Ycol
Next Y<o></o>
End Sub<o></o>
<o> </o>
<o></o>
<o>The PC hangs at step </o>
<o></o>
<o>Sheets("Job Tracking").Range("A15:AX65536").AdvancedFilter Action:= _
xlFilterCopy, CriteriaRange:=Sheets("Job Tracking").Range("A8:AX9"), _
CopyToRange:=Range("A9:M65536"), Unique:=False</o>
<o> </o>
<o></o><o>Can somebody help me out?</o>
<o></o>
<o>Thanks in advance,</o>
<o></o>
<o>awagdarikar</o>
<o></o>
<o></o></o>