copy contents including colour

[gramps]

Hi
In cells A1:B73 I have a list of contacts which are colour coded. What I
want to be able to do is to be able to enter the name of 1 of the contacts in
lets say G1 and it will search for that name in A1:B73 and automatically copy
its colour code over.
Many thanks for any help.
Al

 

[Mike H]

Hi,

I'm assuming that the colour codeing isn't a result of conditional
formatting and it's simply a fill colour. To do this you need VB.

Alt+F11 to open vb editor. Double click the worksheet that this data are on
and paste the code in on the right. Close VB editor and type your name in G1
and your away.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
If Target.Address = "$G$1" Then
Application.EnableEvents = False
On Error GoTo GetMeOut
Set rfound = Range("A1:B73").Find(What:=Target.Value,
After:=Cells(1, 1), _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
Target.Interior.ColorIndex = rfound.Interior.ColorIndex
Application.EnableEvents = True
End If
Exit Sub
GetMeOut:
MsgBox "Lookup no found"
Target.Interior.ColorIndex = xlNone
Application.EnableEvents = True
End Sub
--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.

 

[gramps]

Thanks Mike that's bang on the money!!Al

Hi,

I'm assuming that the colour codeing isn't a result of conditional
formatting and it's simply a fill colour. To do this you need VB.

Alt+F11 to open vb editor. Double click the worksheet that this data are on
and paste the code in on the right. Close VB editor and type your name in G1
and your away.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
If Target.Address = "$G$1" Then
Application.EnableEvents = False
On Error GoTo GetMeOut
Set rfound = Range("A1:B73").Find(What:=Target.Value,
After:=Cells(1, 1), _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
Target.Interior.ColorIndex = rfound.Interior.ColorIndex
Application.EnableEvents = True
End If
Exit Sub
GetMeOut:
MsgBox "Lookup no found"
Target.Interior.ColorIndex = xlNone
Application.EnableEvents = True
End Sub
--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.

 

[Mike H]

Glad I could help and thanks for the feedback
--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.