Transfer Multiple-Font Cells ??

[monir]

Hello;

I did post this question earlier (with the same Subject) at MrExcel forum.
A single respondent DaveMeade (who has put a considerable effort and still
trying) and myself have tested few ideas but nothing has worked so far.
The lack of responses suggests the solution is either too simple or too
complex!!
By reposting in this MS Excel DG (and I apologise if this is considered by
some as cross-posting!) the chances of a MS expert providing the solution
increases considerably.
My earlier thread is located at:
http://www.mrexcel.com/forum/showthread.php?t=358749&goto=newpost

Here's the problem description:
1) Numerous cells in columns A and B on a w/s have a combination of two
fonts each.
For example, cell A5 shows: & 15 on the Formula Bar. The & sign is in
"Wingdings 3" Font code 38, and 15 is in "Arial".
Cell A5 correctly displays: | 15 (i.e.; north east arrow,space,15).
The "wingdings 3" char is always the first char followed by a space followed
by a single- or double-digit number.

2) Other cells on the w/s reference those cells.
For example, cell C5:: = IF($J$41= "Vortex", A5, B5)

Q: When the above condition is true: Is there a way to return | 15 (i.e.;
north east arrow,space,15) in C5, exactly as displayed in A5 ??

3) DaveMeade suggested the following, but it didn't work!!
C5:: =IF($J$41="Vortex",WingDingFormat(A5), B5)

Function WingdingFormat(rng As Range)
WingdingFormat = rng.Value
ActiveCell.Characters(Start:=1, Length:=1).Font.Name = "Wingdings 3"
End Function

4) The above approach appears to have the potential of solving the problem
with some expert tweaking!

Your help would be greatly appreciated.

Thank you kindly.

 

[Sheeloo]

You can not do this using a User Defined Function (UDF) since "UDF cannot
alter the structure or format of a worksheet or cell."

You need to develop a logic using
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
to change the format based on a condition...

We can try to build one for you if you can tell us the logic (under what
conditions to format the first character, or for which cells?

 

[Rick Rothstein]

If the value in a cell is the result of a formula, then you cannot make
parts of the result different, font-wise, from other parts of the result...
it is an all-or-nothing result only. You will need to use Change event code
to perform what your functions are performing in order that it can place
pure text in the cell which it can then apply different font treatments to
parts of it. If you supply more details about the worksheet's layout and
contents and formula requirements (don't just give a single cell example if
more than one cell will need this treatment), then someone here could create
some event code for you to try out.

 

[monir]

Rick and Sheeloo;

Thank you for your prompt and encouraging replies!

Here's the info. you need:
--Excel:: 2003 (Win XP SP 3)
--Worksheet name:: CheckCirc
--cells with a "Wingdings 3" Font char:: G45:G74, S45:S74
--"Wingdings 3" char is always the 1st char followed by a space followed by
a one- or two-digit number in "Arial" Font
--M45 formula:: = IF($J$41= "Vortex", G45, S45)
--formula in M45 is copied down to M74

Kind regards.

 

[Rick Rothstein]

Try this out. Right click the tab at the bottom of the CheckCirc worksheet
and select View Code from the popup menu that appears, then copy/paste the
following code into the code window that appeared...

Private Sub Worksheet_Change(ByVal Target As Range)
Dim X As Long
If Target.Count > 1 Then Exit Sub
If Target.Address = "$J$41" Then
For X = 45 To 74
If Target.Value = "Vortex" Then
Cells(X, "M").Value = Cells(X, "G")
Else
Cells(X, "M").Value = Cells(X, "S")
End If
If Len(Cells(X, "M")) > 0 Then
Cells(X, "M").Font.Name = "Arial"
Cells(X, "M").Characters(1, 1).Font.Name = "Wingdings 3"
End If
Next
End If
End Sub

Now, go back to your worksheet and change the value in J41 to Vortex and
then to something else and tell me if it works the way you want.

Note: Before you start, you can clear out the contents of M45:M74 as the
above code will now be handling what is placed in those cells.

 

[monir]

Rick;

Wow ... Works perfectly and as desired!
Please allow me some time to continue testing to make sure there's no
conflict with the other macros and events.

I hope you don't mind me posting at some point your solution (with the
appropriate acknowledgement) on the other Excel Forum .

Thanks again for your tremendous help.

 

[Rick Rothstein]

Actually, since the text appears in G45:G74 and S45:S74 exactly as you want
it to appear in M45:M74, we can simply copy the appropriate range into
M45:M74 and the formatting will come over with the copy. Doing that
simplifies the code greatly. Give this code a try and it should work the
same as my previous code did...

Private Sub Worksheet_Change(ByVal Target As Range)
Dim R As Range
Set R = Intersect(Target, Range("J41"))
If Not R Is Nothing Then Cells(45, 19 + 12 * (R.Value = "Vortex")). _
Resize(30).Copy Cells(45, "M")
End Sub

Please feel free to post either of these solutions (or both if you want) to
the Excel forum that you mentioned.

 

[monir]

Rick;

Your 2nd solution works as well. No surprise there!!

My preference, however, is your 1st soltion. Its logic is easier (for me!)
to follow, and its code is more adaptable to changes should the need arise.

Having received your permission, I'll shortly post your two solutions on
MrExcel Forum with the proper acknowledgement.

Thanks again for your time and help in resolving the issue.
Monir

 

[Rick Rothstein]

Sorry, I meant to unwind that code before posting it. Here is the same
routine I just posted (my second one), but in a more understandable layout..

Private Sub Worksheet_Change(ByVal Target As Range)
Dim R As Range
Set R = Intersect(Target, Range("J41"))
If Not R Is Nothing Then
If R.Value = "Vortex" Then
Cells(45, "G").Resize(30).Copy Cells(45, "M")
Else
Cells(45, "S").Resize(30).Copy Cells(45, "M")
End If
End If
End Sub

 

[Rick Rothstein]

And this code can be shortened, while still maintaining readability, like
this...

Private Sub Worksheet_Change(ByVal Target As Range)
Dim R As Range
Dim Col As String
Set R = Intersect(Target, Range("J41"))
If Not R Is Nothing Then
If R.Value = "Vortex" Then Col = "G" Else Col = "S"
Cells(45, Col).Resize(30).Copy Cells(45, "M")
End If
End Sub

I would recommend using one of the "copy" routines (probably the one above)
as I believe they will be more efficient than my first offering (which
looped and changed individual characters' font properties).

 

[monir]

Rick;

Got it in time. Thanks again.

Sorry, I meant to unwind that code before posting it. Here is the same
routine I just posted (my second one), but in a more understandable layout..

Private Sub Worksheet_Change(ByVal Target As Range)
Dim R As Range
Set R = Intersect(Target, Range("J41"))
If Not R Is Nothing Then
If R.Value = "Vortex" Then
Cells(45, "G").Resize(30).Copy Cells(45, "M")
Else
Cells(45, "S").Resize(30).Copy Cells(45, "M")
End If
End If
End Sub