Vlookup + cell color function

[astir]

Hi,

I have now used couple of days trying to find and combine others macros without luck to getting this work so hope somebody could help me with this...

Scenario is that i have in one table a "master" devices having a value and color.
master table looks like:
a12=device_name1, c12=text&color, d12=text&color...etc
a13=device_name2, c13=text&color, d13=text&color...etc

*colors are varying much*

and then I have "child" devices where I would like to get same values and color settings automatically than what "master" device have.
child table looks like:
a146=name_of_child, b146=name_of_master, c146=****cell value and color from master device from same column, triggered from b146****
second row like above

I have found a way to change value but not the color:
**in cell C146**=VLOOKUP($B146;$A$12:$E$38;COLUMN(C12))

maybe best would be a function where I can give those same attributes but it also would change the color.

Thank you really much if you can help!!!
-Astir

 

[astir]

ahhh, I got sheet name thing now and changed that to right one, i quess:

Const msMasterSheetName As String = "RAN"
Const msChildSheetName As String = "RAN"


but now it gives another error:

run-time error '1004':application-defined or object-defined error

and will highlight this row:
Set rChild = wsChild.Range(Cells(mlChildrowStart, 3).Address & ":" & _
Cells(mlChildRowEnd, iCol).Address)

 

[astir]

I tried to change max column number(icol) straigh to the code(not sure if its right):

Set rChild = wsChild.Range(Cells(mlChildrowStart, 3).Address & ":" & _
Cells(mlChildRowEnd, 68).Address)
'-- Loop thru child range & copy colour from master if match --
For Each rCur In rChild
iCol = rCur.Column
Set rMaster = wsMaster.Range(Cells(mlMasterRowStart, 68).Address & ":" & _
Cells(mlMasterRowEnd, 68).Address)


Now it wont give any error anymore but colors do not change neither...

Br.
-Astir

 

[al_b_cnu]

Hi Astir,

My mistake Try this code:

Const msMasterSheetName As String = "RAN"
Const msChildSheetName As String = "RAN"
Const mlMasterRowStart As Long = 11
Const mlMasterRowEnd As Long = 38
Const mlChildrowStart As Long = 146
Const mlChildRowEnd As Long = 183

Sub CopyColours()
Dim iCol As Integer
Dim lRow As Long
Dim rMaster As Range
Dim rChild As Range
Dim rCur As Range, rFind As Range
Dim wsMaster As Worksheet
Dim wsChild As Worksheet

Set wsMaster = Sheets(msMasterSheetName)
Set wsChild = Sheets(msChildSheetName)

'-- Set Child range --
iCol = wsChild.UsedRange.Columns.Count
Set rChild = wsChild.Range(Cells(mlChildrowStart, 3).Address & ":" & _
                           Cells(mlChildRowEnd, iCol).Address)

'-- Loop thru child range & copy colour from master if match --
For Each rCur In rChild
    iCol = rCur.Column
    Set rMaster = wsMaster.Range(Cells(mlMasterRowStart, iCol).Address & ":" & _
                                 Cells(mlMasterRowEnd, iCol).Address)
    Set rFind = Nothing
    Set rFind = rMaster.Find(rCur.Value, LookIn:=xlValues)
    If Not rFind Is Nothing Then rCur.Interior.Color = rFind.Interior.Color
Next rCur
End Sub

 

[astir]

**** you are genius it works now, yiihaa

So many thanks to you, really

One more thing still... now when I change color in Master tabel, it wont change automatically in slave table. Would there be some way to do that automatically?

And I also have more of these master/slave tables. So if I want to change them also, I will copy this to some other macro name? Is that the best way?

Thanks
-Astir

 

[al_b_cnu]

Hi Astir,

Not sure if you can automatically change the colours unless you hook into the sheet change event, so the code will fire up if you change a cell within a specified range.

To repeat the code for other ranges, it may be better to amend the existing macro to accept range parameters, and call it with the appropriate ranges. Perhaps you could name the master ranges 'Master1', 'Master2' etc and the corresponding child ranges 'Child1' , 'Child2'.

You then write two (or more) calling macros which quote the required ranges.

 

[al_b_cnu]

Hi Astir,

Here's an example:
First select your Master range then Insert > Name > Define and enter the name 'Master1'
Then select the child range and name that 'Child1'

Option Explicit
Sub CopyColours1()
Dim WS As Worksheet

Set WS = Sheets("RAN")
CopyColours MasterRange:=WS.Range("Master1"), _
            ChildRange:=WS.Range("Child1")
End Sub
Sub CopyColours(ByRef MasterRange As Range, ByRef ChildRange As Range)
Dim iCol As Integer
Dim rChild As Range, rMaster As Range
Dim rCur As Range, rFind As Range
'-- Loop thru child range & copy colour from master if match --
For Each rCur In ChildRange
    iCol = rCur.Column - ChildRange.Column
    Set rMaster = MasterRange.Resize(, 1).Offset(, iCol)
    Set rFind = Nothing
    Set rFind = rMaster.Find(rCur.Value, LookIn:=xlValues)
    If Not rFind Is Nothing Then rCur.Interior.Color = rFind.Interior.Color
Next rCur

End Sub

 

[astir]

Ok thanks for the tips... Basically I want this macro to be run every time when master table is changed.

...Could you would you still give an examble how to add this canhange event fucntion?

thanks once more
-Astir

 

[al_b_cnu]

Hi Adtir,

Assuming that you have two Master & Child named ranges 'Master1', 'Master2', 'Child1' and 'Child2':

right-click the sheet tab and select 'View Code'

Paste the following into the code window:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim iPtr As Integer
Dim rCurMaster As Range

For iPtr = 1 To 2
    Set rCurMaster = Range("Master" & iPtr)
    If Not (Intersect(Target, rCurMaster) Is Nothing) Then
        With Application
            .EnableEvents = False
            CopyColours MasterRange:=rCurMaster, _
                        ChildRange:=Range("Child" & iPtr)
            .EnableEvents = True
        End With
    End If
Next iPtr
End Sub

note that this will only fire if you change the cell contents NOT the colour.

 

[astir]

Ok, thanks a lot once again.

your help were totally great

thanks and regards
-Astir

 

[astir]

still one thing....

would it be hard to implement to the colormatch function an if statement or something that it wont do nothing for that row if column 2=master"key" is blank on that row?

at the moment macro will stop to an error if it is so.

Thx
-Astir