Delay in Generating Macro

[amitkumar123]

Hello ladies and gent <?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
<o></o>
I am a new user to excel and VBA, I have a slight little problem with excel coding. My aim was to generate colour from 20/25 different worksheets in one work book to show colour in a main worksheet. I have linked cells and used VBA code for extra conditional formats. <o></o>
<o> </o>
Problem<o></o>
<o> </o>
On the main worksheet the colour are generated with a macro selecting cells from other worksheet and spiting them on the main worksheet, but i am experiencing some major slowness every time I select generate button. It used to generate straight way and now is very slow and the screen keep on flickering. <o></o>
<o> </o>
I think it’s the VBA code which I got from a site and modified it:<o></o>
<o> </o>
Private Sub Worksheet_Change(ByVal Target As Range)<o></o>
<o></o>
Dim Cell As Range<o></o>
Dim Rng1 As Range<o></o>
<o></o>
On Error Resume Next<o></o>
Set Rng1 = ActiveSheet.Cells.SpecialCells(xlCellTypeFormulas, 1)<o></o>
On Error GoTo 0<o></o>
If Rng1 Is Nothing Then<o></o>
Set Rng1 = Range(Target.Address)<o></o>
Else<o></o>
Set Rng1 = <?xml:namespace prefix = st1 ns = "urn:schemas-microsoft-comffice:smarttags" /><st1lace w:st="on">Union</st1lace>(Range(Target.Address), Rng1)<o></o>
End If<o></o>
For Each Cell In Rng1<o></o>
Select Case Cell.Value<o></o>
Case vbNullString<o></o>
Cell.Interior.ColorIndex = xlNone<o></o>
Cell.Font.Bold = False<o></o>
Case "Red: Serious issues exist"<o></o>
Cell.Interior.ColorIndex = 3<o></o>
Cell.Font.ColorIndex = 3<o></o>
Cell.Font.Bold = True<o></o>
Case "Green: No material issues"<o></o>
Cell.Interior.ColorIndex = 10<o></o>
Cell.Font.ColorIndex = 10<o></o>
Cell.Font.Bold = True<o></o>
Case "White: Not applicable"<o></o>
Cell.Interior.ColorIndex = 2<o></o>
Cell.Font.ColorIndex = 2<o></o>
Cell.Font.Bold = True<o></o>
Case "Amber: some material"<o></o>
Cell.Interior.ColorIndex = 45<o></o>
Cell.Font.ColorIndex = 45<o></o>
Cell.Font.Bold = True<o></o>
Case "Grey: Unable to form a view"<o></o>
Cell.Interior.ColorIndex = 15<o></o>
Cell.Font.ColorIndex = 15<o></o>
Cell.Font.Bold = True<o></o>
Case Else<o></o>
Cell.Interior.ColorIndex = xlNone<o></o>
Cell.Font.Bold = False<o></o>
End Select<o></o>
Next<o></o>
<o></o>
End Sub<o></o>
<o> </o>
<o> </o>
Could you expired kindly help me in this tough situation. <o></o>
<o> </o>
Amitkumar_52@hotmail.com <o></o>
<o> </o>
Kind Regards <o></o>
<o> </o>
A<o></o>

 

[VoG]

Hello and welcome to MrExcel.

Try turning off screen updating:

Dim Rng1 As Range
Application.ScreenUpdating = False
'
'
'
Application.ScreenUpdating = True
End Sub

 

[amitkumar123]

Hi peter <?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
<o></o>
What would be the full code to put into the page with the code that you just supplied? <o></o>

Kind Regard

Amit kumar

 

[VoG]

Try

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cell As Range
Dim Rng1 As Range
Application.ScreenUpdating = False
On Error Resume Next
Set Rng1 = ActiveSheet.Cells.SpecialCells(xlCellTypeFormulas, 1)
On Error GoTo 0
If Rng1 Is Nothing Then
    Set Rng1 = Range(Target.Address)
Else
    Set Rng1 = Union(Range(Target.Address), Rng1)
End If
For Each Cell In Rng1
    Select Case Cell.Value
        Case vbNullString
            Cell.Interior.ColorIndex = xlNone
            Cell.Font.Bold = False
        Case "Red: Serious issues exist"
            Cell.Interior.ColorIndex = 3
            Cell.Font.ColorIndex = 3
            Cell.Font.Bold = True
        Case "Green: No material issues"
            Cell.Interior.ColorIndex = 10
            Cell.Font.ColorIndex = 10
            Cell.Font.Bold = True
        Case "White: Not applicable"
            Cell.Interior.ColorIndex = 2
            Cell.Font.ColorIndex = 2
            Cell.Font.Bold = True
        Case "Amber: some material"
            Cell.Interior.ColorIndex = 45
            Cell.Font.ColorIndex = 45
            Cell.Font.Bold = True
        Case "Grey: Unable to form a view"
            Cell.Interior.ColorIndex = 15
            Cell.Font.ColorIndex = 15
            Cell.Font.Bold = True
        Case Else
                Cell.Interior.ColorIndex = xlNone
                Cell.Font.Bold = False
    End Select
Next
Application.ScreenUpdating = True
End Sub

Be aware that this code

            Cell.Interior.ColorIndex = 3
            Cell.Font.ColorIndex = 3
            Cell.Font.Bold = True

will render the text invisible as it sets both the fill colour and font colour to red.

 

[amitkumar123]

O My Goddddd

buddy you are magic...i love you man...thanks, its working