LinkBack Thread Tools Search this Thread Display Modes
Prev Previous Post   Next Post Next
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 47
Default Grouping and getting faster

Hi,
Could some one please help me with my code. I have NOT done programming
before and more than likely these are simple for others here....

This code is working, but
1) It should be made shorter and clearer ( I suppose it makes thing
several times in vain). Now it checks tha in row 7 when there is number 7 the
cells from 8:500 down will be grey and when there is 12 right border will be
thick. Also in case there is text in column A row will be grey and in case
there is a text in column E the row will be purple.

2) I would like to add code that detects if there is text added to column A
(A8:A500) and updates grouping from text to last empty cell, starting next
group from the following cell continuing to last empty cell. This should be
run each time there is a change in column A.

Thanks in advance...
Make

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rng As Range, rng2 As Range
Dim rng3 As Range
Dim rCell As Range
Dim i As Long
Dim arr As Variant
Dim k As Long
Dim kolA As Double


Const Month7 As String = "7"
Const Month12 As String = "12"

Set rng = Me.Range("A7:CD7")
Set rng3 = Me.Range("A8:CD500")


If Not Intersect(Target, rng3) Is Nothing Then
For Each rCell In rng.Cells
If UCase(rCell.Value) = Month7 Then
rCell(2).Resize(500).Interior.ColorIndex = 15

Else
If UCase(rCell.Value) = Month12 Then
Set Area = (rCell(2).Resize(500))
With Area
.Borders(xlEdgeRight).Weight = xlThick
End With

rCell(2).Resize(500).Interior.ColorIndex = xlNone

Else

kolA = Cells(Rows.Count, "A").End(xlUp).Row
For k = 8 To kolA
If Range("A" & k) < "" Then
Range("A" & k & ":CD" & k).Interior.ColorIndex = 15


End If
Next k

kolA = Cells(Rows.Count, "E").End(xlUp).Row
For k = 8 To kolA
If Range("E" & k) < "" Then
Range("A" & k & ":CD" & k).Interior.ColorIndex = 39

End If
Next k

rCell(2).Resize(500).Interior.ColorIndex = xlNone
Set Area = (rCell(2).Resize(500))
With Area
..Borders(xlEdgeRight).LineStyle = xlNone
End With

End If
End If

Next
End If

End Sub
 
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
can this be done faster? Frank Excel Discussion (Misc queries) 7 August 9th 07 10:02 PM
Any way to do this faster? RB Smissaert Excel Programming 18 January 15th 06 02:32 PM
needs to run faster [email protected] Excel Programming 2 December 2nd 05 09:17 PM
Can faster CPU+larger/faster RAM significantly speed up recalulati jmk_li Excel Discussion (Misc queries) 2 September 28th 05 10:24 AM
Which one is faster? Syed Zeeshan Haider[_4_] Excel Programming 14 December 4th 03 05:28 PM


All times are GMT +1. The time now is 10:55 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"