Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations gkittelson on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Excel VBA Force Change event 2

Status
Not open for further replies.
scribbler99

scribbler99

MIS
Sep 10, 2008
33
GB
Please can anyone enlighten me with the following problem I have.

Firstly I have to say I have browsed this forum and the web with out success.

I have a number of worksheets in my Excel workbook and each one is linked to my "Summary" worksheet. Each of them has a small amount of code contained in the worksheet_change event. This all works fine except that I now want to expand this and force(Call) the worksheet_change event to occur on each workshetsheet if I ammend something manually on my Summary sheet.

Cheers

Colin
 
Sort by date Sort by votes



hi,

Please post the code that you want to run on any sheet. Please specify the sheets you want this to run on: ALL sheets, all but a few specified, or specified.

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Upvote 0 Downvote
Hi Skip

Firstly, tahnks for a quick reply.

I have Sheets No's which contain the code are 2,3,4,5,7,8,9,10,11


The code in each sheet is as follows.

Code: 
Sheet7(HEARTS)
Private Sub Worksheet_Change(ByVal Target As Range)

    If Worksheets("HEARTS").Cells(22, 3).Value <> "" And Worksheets("HEARTS").Cells(22, 4).Value <> "" And Worksheets("HEARTS").Cells(22, 5).Value <> "" Then
        If Worksheets("HEARTS").Cells(30, 16).Value < Worksheets("Summary").Cells(3, 10).Value Then
            Range("J33:Q39").Interior.Color = RGB(255, 0, 0)
            Range("P30").Interior.Color = RGB(255, 0, 0)
        Else
            Range("J33:Q39").Interior.Color = RGB(0, 255, 0)
            Range("P30").Interior.Color = RGB(0, 255, 0)
        End If
    Else
        Range("J33:Q39").Interior.Color = RGB(255, 255, 153)
        Range("P30").Interior.Color = RGB(255, 255, 153)
    End If

End Sub

Cheers

Colin
 
Upvote 0 Downvote

This assumes that HEARTS, DIAMONDS & SPADES are the sheet names you want to apply this to. Change as required.

This code is ONLY IN THE Summery Sheet Code.
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ws As Worksheet
    
    For Each ws In Worksheets
        With ws
            Select Case .Name
                Case "HEARTS", "DIAMONDS", "CLUBS" 'no SPADES or Summary
                    If .Cells(22, 3).Value <> "" And .Cells(22, 4).Value <> "" And .Cells(22, 5).Value <> "" Then
                        If .Cells(30, 16).Value < Worksheets("Summary").Cells(3, 10).Value Then
                            .Range("J33:Q39").Interior.Color = RGB(255, 0, 0)
                            .Range("P30").Interior.Color = RGB(255, 0, 0)
                        Else
                            .Range("J33:Q39").Interior.Color = RGB(0, 255, 0)
                            .Range("P30").Interior.Color = RGB(0, 255, 0)
                        End If
                    Else
                        .Range("J33:Q39").Interior.Color = RGB(255, 255, 153)
                        .Range("P30").Interior.Color = RGB(255, 255, 153)
                    End If
            End Select
        End With
    Next

End Sub
However, this is what I would do.

Make ONE procedure in a MODULE...
Code: 
Sub FormatSheet(ws As Worksheet)
    With ws
        If .Cells(22, 3).Value <> "" And .Cells(22, 4).Value <> "" And .Cells(22, 5).Value <> "" Then
            If .Cells(30, 16).Value < Worksheets("Summary").Cells(3, 10).Value Then
                .Range("J33:Q39").Interior.Color = RGB(255, 0, 0)
                .Range("P30").Interior.Color = RGB(255, 0, 0)
            Else
                .Range("J33:Q39").Interior.Color = RGB(0, 255, 0)
                .Range("P30").Interior.Color = RGB(0, 255, 0)
            End If
        Else
            .Range("J33:Q39").Interior.Color = RGB(255, 255, 153)
            .Range("P30").Interior.Color = RGB(255, 255, 153)
        End If
    End With
End Sub
Then call this procedure in the Summary worksheet change event AND in the Workbook_SheetChange event like
Code: 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    With Sh
        Select Case .Name
            Case "HEARTS", "DIAMONDS", "CLUBS" 'no SPADES or Summary
                FormatSheet Sh
        End Select
    End With
End Sub



Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Upvote 0 Downvote
Hi Skip

I have read your reply, and thought I understood it, but after replacing my code with yours I now do not get any formatting on my worksheets at all. Please can you take a look

I applied the following code to each worksheet (except the STICKS as that has 3 more rows than the others so ammended the code to take account of that one)
Code: 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

    With Sh
        Select Case .Name
            Case "ICE X 10", "CHINA", "COS", "ICEX12", "HEARTS", "gem", "CELERY" 'Excluded Summary sheet
        FormatSheet Sh
        End Select
    End With
End Sub


Then placed the following code into Module1
Code: 
Sub FormatSheet(ws As Worksheet)

    With ws
        If ws <> "STICKS" Then
            If .Cells(22, 3).Value <> "" And .Cells(22, 4).Value <> "" And .Cells(22, 5).Value <> "" Then
                If .Cells(30, 16).Value < Worksheets("Summary").Cells(3, 10).Value Then
                    .Range("J33:Q39").Interior.Color = RGB(255, 0, 0)
                    .Range("P30").Interior.Color = RGB(255, 0, 0)
                Else
                    .Range("J33:Q39").Interior.Color = RGB(0, 255, 0)
                    .Range("P30").Interior.Color = RGB(0, 255, 0)
                End If
            Else
                .Range("J33:Q39").Interior.Color = RGB(255, 255, 153)
                .Range("P30").Interior.Color = RGB(255, 255, 153)
            End If
        
        ElseIf ws = "STICKS" Then ' This is used because teh Sticks spreadsheet has 3 more rows than the others
            If .Cells(22, 3).Value <> "" And .Cells(22, 4).Value <> "" And .Cells(22, 5).Value <> "" Then
                If .Cells(30, 16).Value < Worksheets("Summary").Cells(3, 10).Value Then
                    .Range("J36:Q42").Interior.Color = RGB(255, 0, 0)
                    .Range("P33").Interior.Color = RGB(255, 0, 0)
                Else
                    .Range("J36:Q42").Interior.Color = RGB(0, 255, 0)
                    .Range("P33").Interior.Color = RGB(0, 255, 0)
                End If
            Else
                .Range("J36:Q42").Interior.Color = RGB(255, 255, 153)
                .Range("P33").Interior.Color = RGB(255, 255, 153)
            End If
            
        End If
    End With

End Sub
 
Upvote 0 Downvote


I thot you had a Summary sheet, that when a change occured on the Summary sheet, the FormatSheet procedure would run for that sheet, OR if a change is made on one of those other sheets, the same procedure would run.

Is that true? If so, where is the Summary Sheet event code and which sheet is the Summary Sheet?

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Upvote 0 Downvote

I THINK that this is what you need.

This goes in your module...
Code: 
Sub FormatSheet(ws As Worksheet)
    Dim i As Integer, nColor
    
    With ws
        If ws.Name <> "STICKS" Then
            i = 0
        Else
            i = 3
        End If
        
        If .Cells(22, 3).Value & .Cells(22, 4).Value & .Cells(22, 5).Value <> "" Then
            If .Cells(30, 16).Value < Worksheets("Summary").Cells(3, 10).Value Then
                nColor = RGB(255, 0, 0)
            Else
                nColor = RGB(0, 255, 0)
            End If
        Else
            nColor = RGB(255, 255, 153)
        End If
        
        .Range(.Cells(33 + i, "J"), .Cells(39 + i, "Q")).Interior.Color = nColor
        .Cells(30 + i, "P").Interior.Color = nColor
    End With

End Sub
This goes in the ThisWorkbook object code window...
Code: 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim ws As Worksheet
    
    Select Case Sh.Name
        Case "ICE X 10", "CHINA", "COS", "ICEX12", "HEARTS", "gem", "CELERY", "STICKS" 'Excluded Summary sheet
            FormatSheet Sh
        Case "Summary"
            For Each ws In ThisWorkbook.Worksheets
                Select Case ws.Name
                    Case "ICE X 10", "CHINA", "COS", "ICEX12", "HEARTS", "gem", "CELERY", "STICKS" 'Excluded Summary sheet
                        FormatSheet ws
                End Select
            Next
    End Select
End Sub
NO OTHER CODE, with respect to this logic in any other sheet.

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Upvote 0 Downvote
How about
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets
        If (ws.Name <> "Summary") Then
            On Error Resume Next
            Application.Run ThisWorkbook.Name & "!" & ws.CodeName & ".Worksheet_Change", Target
        End If
    Next
End Sub
 
Upvote 0 Downvote


Dave,

The problem with that approach, in my opinion, although it provides and answer to the original question, proliferates identical code in multiple sheets, which is an unnecessary and undesired overhead in maintenance.

But your solution deserves a [purple]STAR![/purple]

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Upvote 0 Downvote
Hi Skip

The code you provided doesn't quite hit the mark yet but that is due to me not providing you with the complete picture.

On my summary worksheet each of the products has a seperate target value starting column 10 row 3, row 4 etc. also the line of code I highlighted in red causes an error message if some of teh data on the worksheets is not completed in order for the calculation to occur. Would I be ok to use the on error continue code.

Code: 
Sub FormatSheet(ws As Worksheet)
Dim i As Integer, nColor
With ws
    If ws.Name <> "STICKS" Then
        i = 0
    Else
        i = 3
    End If
    
    If .Cells(22, 3).Value & .Cells(22, 4).Value & .Cells(22, 5).Value <> "" Then
[COLOR=red]
        If .Cells(30, 16).Value < Worksheets("Summary").Cells(3, 10).Value Then
[/color]
            nColor = RGB(255, 0, 0)
        Else
            nColor = RGB(0, 255, 0)
        End If
    Else
        nColor = RGB(255, 255, 153)
    End If
    
    .Range(.Cells(33 + i, "J"), .Cells(39 + i, "Q")).Interior.Color = nColor
    .Cells(30 + i, "P").Interior.Color = nColor
End With

End Sub
 
Upvote 0 Downvote
Hi Skip

Just to clarify

I meant to say "On Error Resume Next" not continue

Cheers

Colin




 
Upvote 0 Downvote

Code: 
        If .Cells(30, 16).Value < Worksheets("Summary").Cells(3, 10).Value Then
1) 'continue' to where? you must be much more specific, as you have already realized!

2) ALSO, at the point of error, exactly WHAT value is in ws.cells(30, 16) and what value is in Worksheets("Summary").Cells(3, 10)? Hit DEBUG and find out, using faq707-4594.

3) So exactly what is supposed to happen when a change is made in Summary column 10 row 3?

4) Is the product present on Summary row 3?

Please answer each of the items above.

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Upvote 0 Downvote
Hi Skip

Firstly sorry once again for not making things clearer but just so that the active ws is comparing the relevant row/column on the summary sheet I ammended the line

Code: 
If .Cells(30, 16).Value < Worksheets("Summary").Cells(3, 10).Value Then

To read

Code: 
If .Cells(30, 16).Value < Worksheets("Summary").Cells][COLOR=red]
(6, 10)[/color].Value Then

As on the summary sheet column 10 and rows 3-10 contain the target values for each of the worksheets.

1) I know Resume Next is what you'd probably class as poor code but it did get me around the halting of the code at least for now. I have tried adding into the If statement the following code but it didn't help as I still get the error (obviously at this point I'd taken out the error handling bit)
Code: 
[COLOR=red]
If .Cells(22, 3).Value <> "" & [/color] .Cells(30, 16).Value < Worksheets("Summary").Cells(6, 10).Value Then



2) At the point of error
ws.cells(30, 16) VALUE = Error 2007 Variant/Error
Worksheets("Summary").Cells(6, 10).Value = 10
Worksheets("CHINA").Cells(22, 3).Value = empty
Worksheets("CHINA").Cells(22, 4).Value = .2916666666
Worksheets("CHINA").Cells(22, 5).Value = .3333333333

I realise that the error in ws.cells(30, 16) VALUE is because the user may enter data in a different order than I expected, hence my testing.


3) each ws is actually used to calculate No. of boxes handled per hour based on info from other cells on the ws. Some of the result are summerised on the summary ws. The column 10,3 to 10,10 are where the admin set targets for each product and this is used in the calculation and this can change hence the original reason for me wanting to run the formatting code if a change is made to teh target values.


4) Yes the product is present but this should actually be line 6 hence the reason for my correction mentioned at the beginning of this posting.

Cheers

Colin


 
Upvote 0 Downvote
Code: 
If (.Cells(22, 3).Value <> "" [red]And[/red] .Cells(22, 4).Value <> "" [red]And[/red] .Cells(22, 5).Value <> "") Then
is not the same thing as
Code: 
If (.Cells(22, 3).Value [red]&[/red] .Cells(22, 4).Value [red]&[/red] .Cells(22, 5).Value <> "") Then
also
Code: 
If (.Cells(22, 3).Value <> "" & .Cells(30, 16).Value < Worksheets("Summary").Cells(6, 10).Value) Then
doesn't make any sense either as you're concatenating a Boolean result (.Cells(22, 3).Value <> "") to a cell value.





 
Upvote 0 Downvote
Hi Dave

Sorry. I created My typo error when pasting code into the forum. & should read as "AND"

Cheers

Colin
 
Upvote 0 Downvote
Hi Dave & Skip

The spreadsheets are still not performing. Any further suggestions guys ? Hey there's a star riding on this .....
 
Upvote 0 Downvote


The spreadsheets are still not performing
Click to expand...

That is not very informative! We have no idea on earth what is happening in your sheet. No one can see what you can see. Under those conditions, YOU must paint a word picture that makes your issues come to life.

I fear that you have over engineered a process that might otherwise be solved in another, much more straight-forward manner. If you are interested in pursuing a fresh approch, please explain what your workbook is about without resorting to code-terms or computerese; NOT how you are trying to make it work.

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Upvote 0 Downvote
Hi Skip

Sorry but I, obviously incorrectly, assumed from my reply to your earlier 4 questions that was giving you a picture. I am happy to provide you with a copy of my workbook but do mot know if either, this posting forum facilitates this or you would even wish to view, as I know that you guys, rightly so, prefer for us minions to try and use our gray matter rather than expect you to complete a task for us.

Regards

Colin
 
Upvote 0 Downvote



My previous 4 questions were of an entirely different nature than my standing question.

Those questions were focused on the HOW. Right now, I feel that the WHAT is more important in order to determine the best HOW options.

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Upvote 0 Downvote
Hi Skip

I did mention earlier that I am happy to provide you with a copy of my workbook but do not know if either, this posting forum facilitates the uploading of a file from my PC or you would even wish to view it, as I know that you guys prefer for us minions to try and use our gray matter rather than expect you to complete a task for us.

If the answer either of the above is No then I will attempt to explain in better detail.
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

huiettcm
  • Locked
  • Question
Excel UserForm Window 'Focus' Event Listener 1
Replies
14
Views
576
huiettcm
huiettcm
remeng
  • Locked
  • Question
Run PowerShell Commands from Excel VBA
Replies
14
Views
3K
dhookom
dhookom
thanhthanh12
  • Locked
  • Question
Help vba
Replies
3
Views
477
combo
combo
Andrzejek
  • Locked
  • Question
Outlook VBA - Trust access
Replies
3
Views
759
hermanlaksko
hermanlaksko
remeng
  • Locked
  • Question
Excel VBA to Pass Var between file macros after var changes
Replies
13
Views
546
mikrom
mikrom

Part and Inventory Search

Sponsor

Back
Top