Hi
I am filled interior color on the cell typing specified mentioned
character(as below)
I'll expect fill the color every open workbook, but i fills only one
cell
what's error in my code

I used this code on Eventclass (Class Modules)

Option Explicit

Public WithEvents App As Application

Private Sub App_NewWorkbook(ByVal Wb As Excel.Workbook)
MsgBox "Application Event: New Workbook: " & Wb.Name
End Sub

Private Sub App_SheetActivate(ByVal Sh As Object)
MsgBox "Application Event: SheetActivate: " & Sh.Name
End Sub

Public Sub App_WorkbookOpen(ByVal Wb As Excel.Workbook)
MsgBox "Application Event: WorkbookOpen: " & Wb.Name
End Sub

Public Sub App_SheetChange(ByVal Sh As Object, ByVal Target As
Excel.Range)
Dim cell As Range
Dim charArr As Variant
Dim colorArr As Variant
Dim i As Long

charArr = Array("s", "d", "t", "c", "c-", "pc")
colorArr = Array(3, 4, 5, 6, 7, 8)
Application.EnableEvents = False

For Each cell In Target
With cell
.Interior.ColorIndex = xlColorIndexNone
For i = 0 To UBound(charArr)
If .Value = charArr(i) Then
MsgBox ("first")
.Interior.ColorIndex = colorArr(i)
Exit For
End If
Next i
End With
Next cell
End Sub
-------------------------------------------------
This work book code

Option Explicit

Dim Appclass As New EventClass

Private Sub Workbook_Open()
Set Appclass.App = Application
End Sub

please suggest me, how to fill every open workbook?

Thanks
Venky

You turn events off, but never turn them back on.

You can either add
application.enableevents = true
right before the End Sub in the app_sheetchange event procedure.

Or because formatting doesn't cause an event to fire, you could remove the
application.enableevents = false
line.





wrote:

Hi
I am filled interior color on the cell typing specified mentioned
character(as below)
I'll expect fill the color every open workbook, but i fills only one
cell
what's error in my code

I used this code on Eventclass (Class Modules)

Option Explicit

Public WithEvents App As Application

Private Sub App_NewWorkbook(ByVal Wb As Excel.Workbook)
MsgBox "Application Event: New Workbook: " & Wb.Name
End Sub

Private Sub App_SheetActivate(ByVal Sh As Object)
MsgBox "Application Event: SheetActivate: " & Sh.Name
End Sub

Public Sub App_WorkbookOpen(ByVal Wb As Excel.Workbook)
MsgBox "Application Event: WorkbookOpen: " & Wb.Name
End Sub

Public Sub App_SheetChange(ByVal Sh As Object, ByVal Target As
Excel.Range)
Dim cell As Range
Dim charArr As Variant
Dim colorArr As Variant
Dim i As Long

charArr = Array("s", "d", "t", "c", "c-", "pc")
colorArr = Array(3, 4, 5, 6, 7, 8)
Application.EnableEvents = False

For Each cell In Target
With cell
.Interior.ColorIndex = xlColorIndexNone
For i = 0 To UBound(charArr)
If .Value = charArr(i) Then
MsgBox ("first")
.Interior.ColorIndex = colorArr(i)
Exit For
End If
Next i
End With
Next cell
End Sub
-------------------------------------------------
This work book code

Option Explicit

Dim Appclass As New EventClass

Private Sub Workbook_Open()
Set Appclass.App = Application
End Sub

please suggest me, how to fill every open workbook?

Thanks
Venky

--

Dave Peterson