Combining Two Codes (from Workbook and Worksheet)

**FallingDown** · 12-29-2011, 11:35 AM

Hi all

I currently have two codes:

On Sheet1

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim RaFound As Range
    If Target.Count = 1 Then
        If Target.Column = 1 Then
            With Worksheets("Master Sheet")
                                Set RaFound = .Columns().Find(Target, .Range("A1"), _
                    , xlPart, , xlNext)
                If RaFound Is Nothing Then
                    Target.Offset(0, 1).Font.ColorIndex = xlNone
                  
                Else
                    
                    Target.Offset(6, 12).Font.ColorIndex = _
                        RaFound.Offset(0, 4).Font.ColorIndex 
                        
                    Target.Offset(7, 12).Font.ColorIndex = _
                        RaFound.Offset(0, 5).Font.ColorIndex 

                    Target.Offset(8, 12).Font.ColorIndex = _
                        RaFound.Offset(0, 6).Font.ColorIndex

                    Target.Offset(9, 12).Font.ColorIndex = _
                        RaFound.Offset(0, 7).Font.ColorIndex

                    Target.Offset(10, 12).Font.ColorIndex = _
                        RaFound.Offset(0, 8).Font.ColorIndex 

                    Target.Offset(11, 12).Font.ColorIndex = _
                        RaFound.Offset(0, 9).Font.ColorIndex 

                    Target.Offset(12, 12).Font.ColorIndex = _
                        RaFound.Offset(0, 10).Font.ColorIndex 

                End If
            End With
            Set RaFound = Nothing
        End If
    End If
End Sub

On the Workbook

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    On Error Resume Next
    
    With ThisWorkbook
    
        If Sh.Name = "Master Sheet" And Target.Address = "$G$3" Then
            For Each Sh In .Worksheets
            
            Application.ScreenUpdating = False
            
                If Sh.Name <> "Master Sheet" Then
                    Sh.Visible = (InStr(1, Sh.Name, Target.Value, vbTextCompare) > 0)
                    
                End If
            Next Sh
            Application.ScreenUpdating = True
        End If
    End With
        If Target.Address = "$C$1" Then Sh.Name = Target
    
End Sub

I have tried to include the "Sheet Code" into the "Workbook Code", which results in

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    On Error Resume Next
    
    With ThisWorkbook
    
        If Sh.Name = "Master Sheet" And Target.Address = "$G$3" Then
            For Each Sh In .Worksheets
            
            Application.ScreenUpdating = False
            
                If Sh.Name <> "Master Sheet" Then
                    Sh.Visible = (InStr(1, Sh.Name, Target.Value, vbTextCompare) > 0)
                    
                End If
            Next Sh
            Application.ScreenUpdating = True
        End If
    End With
        If Target.Address = "$C$1" Then Sh.Name = Target
    
    Next
    For Each Sh In .Worksheets
    If Sh.Name <> "Master Sheet" Then
        Dim RaFound As Range
    If Target.Count = 1 Then
        If Target.Column = 1 Then
            With Worksheets("Master Sheet")
                                Set RaFound = .Columns().Find(Target, .Range("A1"), _
                    , xlPart, , xlNext)
                If RaFound Is Nothing Then
                    Target.Offset(0, 1).Font.ColorIndex = xlNone
                  
                Else
                    
                    Target.Offset(6, 12).Font.ColorIndex = _
                        RaFound.Offset(0, 4).Font.ColorIndex 
                        
                    Target.Offset(7, 12).Font.ColorIndex = _
                        RaFound.Offset(0, 5).Font.ColorIndex

                    Target.Offset(8, 12).Font.ColorIndex = _
                        RaFound.Offset(0, 6).Font.ColorIndex 

                    Target.Offset(9, 12).Font.ColorIndex = _
                        RaFound.Offset(0, 7).Font.ColorIndex

                    Target.Offset(10, 12).Font.ColorIndex = _
                        RaFound.Offset(0, 8).Font.ColorIndex 

                    Target.Offset(11, 12).Font.ColorIndex = _
                        RaFound.Offset(0, 9).Font.ColorIndex 

                    Target.Offset(12, 12).Font.ColorIndex = _
                        RaFound.Offset(0, 10).Font.ColorIndex 

                End If
            End With
            Set RaFound = Nothing
        End If
        End If
    End If

Can anyone spot where I went wrong about this?

Thx a lot

**arvin** · 12-29-2011, 11:57 AM

If you are calling the sub MySheet2Sub located in Sheet2 from Sheet1 you would use

Sheet2.MySheet2Sub

**FallingDown** · 12-29-2011, 12:27 PM

Hi Arvin

Thanks for your post.

I am not quite sure I quite understand what you mean? Could you please explain this a little more in detail?

The thing is that my workbook has 200 Sheets (plus one Master Sheet (where all the data is stored), plus one "admin sheet" (used for defining drop-downs, etc.)
Each of these 200 sheets look the same. (ie. are a pre-defined form). And the values are all filled in via VLookup poiting to the Master Sheet.

Problem I am experiencing: Each of these VLookUps should carry the same font color as the value on my Master Sheet.
I have achied this with the code (see the first code posted in my original comment)

Sure, I could copy the code of the worksheet into each of the 200 Sheets - but if there is an amendment to the form I'd have to modify all 200 codes.

So I am looking for a way to have this code on "This Workbook".

--> I have tried removing the existing code on "This Workbook" and have only posted the code I currently have on the "worksheet", but that didn't work.
So I can't figure out where I am going wrong with this.

Thanks a lot for all the help

FD

**arvin** · 12-29-2011, 12:39 PM

can you explain the purpose of the 2 codes please?

**FallingDown** · 12-29-2011, 02:51 PM

Hi

Sure:

The following code is entered in "This workbook"


	

	
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    On Error Resume Next
    
    With ThisWorkbook
    
        If Sh.Name = "Master Sheet" And Target.Address = "$G$3" Then
            For Each Sh In .Worksheets
            
            Application.ScreenUpdating = False
            
                If Sh.Name <> "Master Sheet" Then
                    Sh.Visible = (InStr(1, Sh.Name, Target.Value, vbTextCompare) > 0)
                    
                End If
            Next Sh
            Application.ScreenUpdating = True
        End If
    End With
        If Target.Address = "$C$1" Then Sh.Name = Target
    
End Sub

The first "block" is more or less a search field.
When a value is entered in the target cell, on my Master Sheet, all Tab Names in the Woorkbook contatining the entered value will be displayed (or much rather, all those not containing the values will be hidden). The Tab "Master Sheet" is excluded with this part "If Sh.Name <> "Master Sheet" Then"

The second part just defined the tab name (off all other sheet), based on a value entered in Cell C3 in each of the sheets.

--> This part is fine, no problem there!

___________________________________________________________________________________________

The following code is entered in "Sheet 1" (for testing purposes, once finalized it should take effect on all sheets, that's why I'm looking for a way to integrate it on "this workbook)


Private Sub Worksheet_Change(ByVal Target As Range)
    Dim RaFound As Range
    If Target.Count = 1 Then
        If Target.Column = 1 Then
            With Worksheets("Master Sheet")
                                Set RaFound = .Columns().Find(Target, .Range("A1"), _
                    , xlPart, , xlNext)
                If RaFound Is Nothing Then
                    Target.Offset(0, 1).Font.ColorIndex = xlNone
                  
                Else
                    
                    Target.Offset(6, 12).Font.ColorIndex = _
                        RaFound.Offset(0, 4).Font.ColorIndex 
                        
                    Target.Offset(7, 12).Font.ColorIndex = _
                        RaFound.Offset(0, 5).Font.ColorIndex 

                    Target.Offset(8, 12).Font.ColorIndex = _
                        RaFound.Offset(0, 6).Font.ColorIndex

                    Target.Offset(9, 12).Font.ColorIndex = _
                        RaFound.Offset(0, 7).Font.ColorIndex

                    Target.Offset(10, 12).Font.ColorIndex = _
                        RaFound.Offset(0, 8).Font.ColorIndex 

                    Target.Offset(11, 12).Font.ColorIndex = _
                        RaFound.Offset(0, 9).Font.ColorIndex 

                    Target.Offset(12, 12).Font.ColorIndex = _
                        RaFound.Offset(0, 10).Font.ColorIndex 

                End If
            End With
            Set RaFound = Nothing
        End If
    End If
End Sub

What this does is: It is linked to a VLookUp (all cells in the sheet have cell A1 as the lookup value), which gets the value from the Master Sheet

Target.Offset(6, 12).Font.ColorIndex = _ ---> This part defines which cell should be updated on the sheet (in this case it's defined as the 6th row after A1 (so row 7), and the 12 column after A1 (so column M) (in this case it would be cell M7)

RaFound.Offset(0, 4).Font.ColorIndex ---> This part defines from which cell on my Master sheet the font color should be taken from.
The row is defined as the one where VLookUp has a hit (hence offset 0, since when there's a hit, the row does not change anymore), but the column the font color should be taken from is the one 4 columns after the cell where VLookUp has a hit (which could be for example A14, the the cell from which the font would be copied is E14)

As there are multiple cells, which should copy the font color, I'll have to define each cell (that's why there are multiple lines with this part of the code)

---> As I said, this code works perfectly fine when copied to the sheet code, but not when posted on "this workbook".

I have tried my best to explain the codes, I hope you can understand what I am lookig for.

Thanks a lot

FD

**FallingDown** · 12-30-2011, 03:19 AM

Hi all

Sorry, I was a little bit too confused yesterday to notice that the two codes cannot be combined, since one is a "Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)" and the other simply a "Worksheet_Change(ByVal Target As Range)".

Nonetheless, I would still need help with the "Worksheet_Change(ByVal Target As Range)" code
Currently I have this code on "sheet 1" (please see my above post to see what it does)

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim RaFound As Range
    If Target.Count = 1 Then
        If Target.Column = 1 Then
            With Worksheets("Master Sheet")
                                Set RaFound = .Columns().Find(Target, .Range("A1"), _
                    , xlPart, , xlNext)
                If RaFound Is Nothing Then
                    Target.Offset(0, 1).Font.ColorIndex = xlNone
                  
                Else
                    
                    Target.Offset(6, 12).Font.ColorIndex = _
                        RaFound.Offset(0, 4).Font.ColorIndex 
                        
                    Target.Offset(7, 12).Font.ColorIndex = _
                        RaFound.Offset(0, 5).Font.ColorIndex 

                    Target.Offset(8, 12).Font.ColorIndex = _
                        RaFound.Offset(0, 6).Font.ColorIndex

                    Target.Offset(9, 12).Font.ColorIndex = _
                        RaFound.Offset(0, 7).Font.ColorIndex

                    Target.Offset(10, 12).Font.ColorIndex = _
                        RaFound.Offset(0, 8).Font.ColorIndex 

                    Target.Offset(11, 12).Font.ColorIndex = _
                        RaFound.Offset(0, 9).Font.ColorIndex 

                    Target.Offset(12, 12).Font.ColorIndex = _
                        RaFound.Offset(0, 10).Font.ColorIndex 

                End If
            End With
            Set RaFound = Nothing
        End If
    End If
End Sub

--> since I need this code to take effect on all sheets I'd like to put it in "this workbook".

I am sorry about the confustion.

Regards

FD