need some help with: formatting of x2 dates in 1 cell

[NickPR]

Hi and thanks to anyone who reads this.

I have a worksheet which contains two columns of dates.
In a second worksheet i have a column which adds the two dates together
as TEXT and ommits dates which are blank which works perfectly,
however:

I would like to know how i could format each of the 2 dates in the 1
cell to have different font colors?

Here is my existing cell formula:

=IF('Data'!E2=0,"",(TEXT('Data'!E2,"dd/mm/yy"))&"
"&IF('Data'!F2=0,"",TEXT('Data'!F2,"dd/mm/yy")))

I have a feeling its not conditional formating, as that won't allow me
to use formulas across different worksheets, and i've tried for ages
with custom cell formatting too.

Any ideas would be greatly appreciated

 

[NickPR]

Well it seems i cannot use formatting in this way on anything but text
strings. Does anybody know a way to apply VB to this situation please?

thanks.

 

[Ron Rosenfeld]

Hi and thanks to anyone who reads this.

I have a worksheet which contains two columns of dates.
In a second worksheet i have a column which adds the two dates together
as TEXT and ommits dates which are blank which works perfectly,
however:

I would like to know how i could format each of the 2 dates in the 1
cell to have different font colors?

Here is my existing cell formula:

=IF('Data'!E2=0,"",(TEXT('Data'!E2,"dd/mm/yy"))&"
"&IF('Data'!F2=0,"",TEXT('Data'!F2,"dd/mm/yy")))

I have a feeling its not conditional formating, as that won't allow me
to use formulas across different worksheets, and i've tried for ages
with custom cell formatting too.

Any ideas would be greatly appreciated

As far as I know, you can only have different characters in the same cell
formatted with different font colors if the contents of the cell is a text
string.

That means that, instead of having a formula in the cells on your worksheet,
you would need to run a VBA Sub that would read the data from 'Data!, and then
format it appropriately.

Something like:

===================================
Sub CombineDates()
Dim Source As Range
Dim Target As Range
Dim i As Long

Set Source = Worksheets("Data").Range("E2:F10")
Set Target = Worksheets("Sheet2").Range("A2:A10")

For i = 1 To Source.Rows.Count
Target(i, 1).NumberFormat = "@"
If IsDate(Source(i, 1)) Then
Target(i, 1) = Format(Source(i, 1), "dd/mm/yy")
Else: Target(i, 1) = ""
End If
If IsDate(Source(i, 2)) Then
Target(i, 1) = Target(i, 1) & " " & Format(Source(i, 2), "dd/mm/yy")
End If
Target(i, 1) = Trim(Target(i, 1))
With Target(i, 1)
.Characters(1, 8).Font.Color = vbRed
.Characters(10, 8).Font.Color = vbGreen
End With
Next i

End Sub
=======================


--ron

 

[NickPR]

Ron, that was perfect, thankyou, your a star! :

 

[NickPR]

would there be a way to have the macro run every 5min? So that it keeps
up-to- date with the source data Worksheet?

Thanks again,

Nick.

 

[Ron Rosenfeld]

would there be a way to have the macro run every 5min? So that it keeps
up-to- date with the source data Worksheet?

Thanks again,

Nick.

If your goal is to keep things up to date, then an event driven macro might be
better. You could use the worksheet change event which would trigger if you
changed a cell in Source.

For example:

============================
Private Sub Worksheet_Change(ByVal Target As Range)
Dim aoi As Range
Set aoi = Worksheets("Data").Range("$E$2:$F$10")

If Not Intersect(Target, aoi) Is Nothing Then
CombineDates
End If

End Sub
===========================

To enter this sort of macro, right-click on the sheet tab for your Data
worksheet and select View Code from the right-click menu.

Then paste the code into the window that opens.


--ron

 

[NickPR]

If your goal is to keep things up to date, then an event driven macro
might be
better. You could use the worksheet change event which would trigger
if you
changed a cell in Source.

For example:

============================
Private Sub Worksheet_Change(ByVal Target As Range)
Dim aoi As Range
Set aoi = Worksheets("Data").Range("$E$2:$F$10")

If Not Intersect(Target, aoi) Is Nothing Then
CombineDates
End If

End Sub
===========================

To enter this sort of macro, right-click on the sheet tab for your
Data
worksheet and select View Code from the right-click menu.

Then paste the code into the window that opens.


--ron

Works perfectly with number fields, thanks again

With regards to the formatting of colors, to extend what you have done,
i am trying to add together a date with 3 other columns of text. Here is
what i have so far:


Code:
--------------------

Sub CombineInitData()
Dim Source1 As Range
Dim Source2 As Range
Dim Source3 As Range
Dim Source4 As Range
Dim Target As Range

Dim ab As Long
Dim bc As Long
Dim cd As Long


Dim i As Long

Set Source1 = Worksheets("Data").Range("A2:A16")
Set Source2 = Worksheets("Data").Range("B2:B16")
Set Source3 = Worksheets("Data").Range("C2:C16")
Set Source4 = Worksheets("Data").Range("D216")
Set Target = Worksheets("Worksheet1").Range("A2:A16")

For i = 1 To Source1.Rows.Count

If IsDate(Source4(i, 1)) Then
Target(i, 1) = Format(Source4(i, 1), "dd/mm/yy")
Else: Target(i, 1) = ""
End If

If IsNull(Source2(i, 1)) Then
Target(i, 1) = ""
Else: Target(i, 1) = Target(i, 1) & " / " & (Source2(i, 1)) & " / " & (Source3(i, 1)) & " / " & (Source4(i, 1))
End If

Target(i, 1) = Trim(Target(i, 1))
With Target(i, 1)
.Characters(1, ab).Font.ColorIndex = 10
.Characters(ab, bc).Font.ColorIndex = 3
.Characters(bc, cd).Font.ColorIndex = 5
End With

Next i

End Sub

--------------------


Am i assuming correctly that i need to count the number of chars from
each source to ditermin the number of characters to trim from and to?

Many thanks for your help,

Nick

Edit: Just trying the following doesn't seem to work either:

Set ab = Source1.Characters.Count

Would an array be required?

 

[NickPR]

Well this is my latest code and it doesn't seem to work. No errors
though..

Sub CombineInitData()
Dim Source1 As Range
Dim Source2 As Range
Dim Source3 As Range
Dim Source4 As Range
Dim Target As Range

Dim ab As String
Dim bc As Long
Dim cd As Long


Dim i As Long

Set Source1 = Worksheets("Data").Range("A2:A16")
Set Source2 = Worksheets("Data").Range("B2:B16")
Set Source3 = Worksheets("Data").Range("C2:C16")
Set Source4 = Worksheets("Data").Range("D216")
Set Target = Worksheets("Worksheet1").Range("A2:A16")




For i = 1 To Source1.Rows.Count

ab = Source1(i, 1).Characters.Count

If IsDate(Source4(i, 1)) Then
Target(i, 1) = Format(Source4(i, 1), "dd/mm/yy")
Else: Target(i, 1) = ""

End If


If IsNull(Source2(i, 1)) Then
Target(i, 1) = ""
Else: Target(i, 1) = Target(i, 1) & " / " & (Source2(i, 1)) & " / " &
(Source3(i, 1)) & " / " & (Source4(i, 1))

End If

Target(i, 1) = Trim(Target(i, 1))
With Target(i, 1)
..Characters(1, ab).Font.ColorIndex = 10
..Characters(ab, bc).Font.ColorIndex = 3
..Characters(bc, cd).Font.ColorIndex = 5
End With

Next i

End Sub

 

[Ron Rosenfeld]

Am i assuming correctly that i need to count the number of chars from
each source to ditermin the number of characters to trim from and to?

I used the Trim function to remove the leading <space> that would appear in my
routine if there was nothing in the first column of Source. So the answer is
no; and you may not even require it.

I was using it because in my testing, if Target contained only a single date,
Excel might convert it to an Excel date, rather than a text string, unless
there was something that made that impossible (like a leading space).

Many thanks for your help,

Nick

Edit: Just trying the following doesn't seem to work either:

Set ab = Source1.Characters.Count

Would an array be required?

Since ab is not an object, you would not use the Set statement. Try just a
simple equality:

ab = Len(Source1(i,1).text)


--ron

 

[Ron Rosenfeld]

Well this is my latest code and it doesn't seem to work. No errors
though..

What does "doesn't seem to work" mean?

I'm very surprised that you see no error messages.

I see both logic and syntax errors, and I don't know what your source data
looks like.

Why is ab Dim'd as String?

You never set bc or cd to anything, so they will effectively be zero(0).

Where you set the ColorIndex property of Characters, you don't specify any
Object for Characters to be a Property of (need to put '.'s in front of the
Characters to have them be a property of Target(i,1)



HTH,
--ron

Sub CombineInitData()
Dim Source1 As Range
Dim Source2 As Range
Dim Source3 As Range
Dim Source4 As Range
Dim Target As Range

Dim ab As String
Dim bc As Long
Dim cd As Long


Dim i As Long

Set Source1 = Worksheets("Data").Range("A2:A16")
Set Source2 = Worksheets("Data").Range("B2:B16")
Set Source3 = Worksheets("Data").Range("C2:C16")
Set Source4 = Worksheets("Data").Range("D216")
Set Target = Worksheets("Worksheet1").Range("A2:A16")




For i = 1 To Source1.Rows.Count

ab = Source1(i, 1).Characters.Count

If IsDate(Source4(i, 1)) Then
Target(i, 1) = Format(Source4(i, 1), "dd/mm/yy")
Else: Target(i, 1) = ""

End If


If IsNull(Source2(i, 1)) Then
Target(i, 1) = ""
Else: Target(i, 1) = Target(i, 1) & " / " & (Source2(i, 1)) & " / " &
(Source3(i, 1)) & " / " & (Source4(i, 1))

End If

Target(i, 1) = Trim(Target(i, 1))
With Target(i, 1)
Characters(1, ab).Font.ColorIndex = 10
Characters(ab, bc).Font.ColorIndex = 3
Characters(bc, cd).Font.ColorIndex = 5
End With

Next i

End Sub

--ron

 

[NickPR]

ok, so since using Len() it now appears to be modifying the text Target,
but in an odd way... When i first applied formatting to Source1, i had
to + 2 to make it goto the correct position. Is that due to Len not
counting white spaces?

Then, by the time i had got to entering the 4th Source formatting, the
entire output had color applied but all out of place, not even
back-to-front (see attachment).

Heres the code for it:

Code:
--------------------

Target(i, 1) = Trim(Target(i, 1))
ab = Len(Source1(i, 1).Text)
bc = Len(Source2(i, 1).Text)
cd = Len(Source3(i, 1).Text)
de = Len(Source4(i, 1).Text)
With Target(i, 1)
.Characters(1, ab).Font.ColorIndex = 5
.Characters(ab, bc).Font.ColorIndex = 10
.Characters(bc, cd).Font.ColorIndex = 3
.Characters(cd, de).Font.ColorIndex = 7

End With

--------------------


Anyway, thanks for your help today, i was totally stuck before this, at
least now i have something to work on


+-------------------------------------------------------------------+
|Filename: sample.gif |
|Download: http://www.excelforum.com/attachment.php?postid=3842 |
+-------------------------------------------------------------------+

 

[Ron Rosenfeld]

ok, so since using Len() it now appears to be modifying the text Target,
but in an odd way... When i first applied formatting to Source1, i had
to + 2 to make it goto the correct position. Is that due to Len not
counting white spaces?

Then, by the time i had got to entering the 4th Source formatting, the
entire output had color applied but all out of place, not even
back-to-front (see attachment).

Heres the code for it:

Code:
--------------------

Target(i, 1) = Trim(Target(i, 1))
ab = Len(Source1(i, 1).Text)
bc = Len(Source2(i, 1).Text)
cd = Len(Source3(i, 1).Text)
de = Len(Source4(i, 1).Text)
With Target(i, 1)
.Characters(1, ab).Font.ColorIndex = 5
.Characters(ab, bc).Font.ColorIndex = 10
.Characters(bc, cd).Font.ColorIndex = 3
.Characters(cd, de).Font.ColorIndex = 7

End With

--------------------


Anyway, thanks for your help today, i was totally stuck before this, at
least now i have something to work on

I'm having some issues with my virus protection program so don't download
attachments, but:

LEN counts any printing character, included <space>, if it is there. But if
you are checking LEN in Source, and then adding <space>'s in Target, you can
easily get out of sync unless you account for them.

As a matter of fact, it might be easier to debug if you stored your text string
in a temporary string variable, before writing it to Target. Also you might
not need some of the stuff I added to ensure that Target would not reformat my
results.


--ron

 

[NickPR]

Ron, you're the best!

Heres what i have working now:


Sub CombineInitData()
Dim Source1 As Range
Dim Source2 As Range
Dim Source3 As Range
Dim Source4 As Range
Dim Target As Range
Dim i As Long
Dim testing As String

Set Source1 = Worksheets("Data").Range("A2:A16")
Set Source2 = Worksheets("Data").Range("B2:B16")
Set Source3 = Worksheets("Data").Range("C2:C16")
Set Source4 = Worksheets("Data").Range("D216")
Set Target = Worksheets("Worksheet1").Range("A2:A16")

For i = 1 To Source1.Rows.Count

'If IsNull(Source2(i, 1)) Then
'Target(i, 1) = ""
'Else: Target(i, 1) = Source1(i, 1) & " / " & (Source2(i, 1) & " / " &
(Source3(i, 1) & " / " & (Source4(i, 1))))
'End If

testing = Source1(i, 1) & " / " & Source2(i, 1) & " / " & Source3(i, 1)
& " / " & Format(Source4(i, 1), "dd/mm/yy")
Target(i, 1) = testing
Target(i, 1) = Trim(Target(i, 1))
ab = Len(Source1(i, 1).Text) + 3
bc = Len(Source2(i, 1).Text) + 3
cd = Len(Source3(i, 1).Text) + 3
de = Len(Source4(i, 1).Text) + 3
With Target(i, 1)
Characters(1, ab).Font.ColorIndex = 5
Characters(ab, bc).Font.ColorIndex = 10
Characters(ab + bc, cd).Font.ColorIndex = 3
Characters(ab + bc + cd, de).Font.ColorIndex = 7

End With

Next i

End Sub
======================

I had to append the previous number to the next to get the correct
starting point for .Characters(). Your idea about debugging to a string
got me thinking straight

Now working on removing the / / / when fields have no data and im done!

 

[Ron Rosenfeld]

I had to append the previous number to the next to get the correct
starting point for .Characters(). Your idea about debugging to a string
got me thinking straight

I'm glad you're getting things working for your project.

Good luck and best wishes,

--ron

 

[NickPR]

Thanks Ron

*to anyone reading this!!!, as im sure its not just Ron*

The problem of getting rid of the / / / is proving to be a tedious one
I have tried various ways to set each of the 4 sources to if els
statements and then assign that output to a variable to place i
Target1, but no joy. This is the Target1 string:

=====================================
Target1(i, 1).NumberFormat = "@"
If IsDate(Source1(i, 1)) Then
Target1(i, 1) = Format(Source1(i, 1), "dd/mm/yy") & " / "
Format(Source2(i, 1), "dd/mm/yy") & " / " & Format(Source3(i, 1)
"dd/mm/yy") & " / " & Format(Source4(i, 1), "dd/mm/yy")
Else: Target1(i, 1) = ""
End If
=====================================

As you can see, if Source1 has a date and the other 3 Sources hav
nothing, i'm left with unsightly / / /'s. What would be a logica
method for purging these please?

Regards,

Nick Payne-Roberts (UK, so might not reply tonight)

-*hopes that someone else other than Ron Rosenfeld replies, as he'
been the only person to give me feedback so far, and i'm feeling ver
guilty (and grateful) for that.*

 

[Ron Rosenfeld]

Thanks Ron

*to anyone reading this!!!, as im sure its not just Ron*

The problem of getting rid of the / / / is proving to be a tedious one.
I have tried various ways to set each of the 4 sources to if else
statements and then assign that output to a variable to place in
Target1, but no joy. This is the Target1 string:

=====================================
Target1(i, 1).NumberFormat = "@"
If IsDate(Source1(i, 1)) Then
Target1(i, 1) = Format(Source1(i, 1), "dd/mm/yy") & " / " &
Format(Source2(i, 1), "dd/mm/yy") & " / " & Format(Source3(i, 1),
"dd/mm/yy") & " / " & Format(Source4(i, 1), "dd/mm/yy")
Else: Target1(i, 1) = ""
End If
=====================================

As you can see, if Source1 has a date and the other 3 Sources have
nothing, i'm left with unsightly / / /'s. What would be a logical
method for purging these please?

Regards,

Nick Payne-Roberts (UK, so might not reply tonight)

-*hopes that someone else other than Ron Rosenfeld replies, as he's
been the only person to give me feedback so far, and i'm feeling very
guilty (and grateful) for that.*-

Here's to more guilt )

Try this approach:

-------------------------------
Sub CombineInitData()
Dim Source As Range
Dim Target As Range
Dim i As Long, j As Long
Dim LenS(1 To 4) As Long
Dim StartS(1 To 4) As Long
Dim Temp As String

Set Source = Worksheets("Data").Range("A216")
Set Target = Worksheets("Worksheet1").Range("A2:A16")

For i = 1 To Source.Rows.Count
If IsDate(Source(i, 1)) Then
Temp = Format(Source(i, 1), "dd/mm/yy") & " / "
LenS(1) = 8
StartS(1) = 1
Else: Temp = ""
End If
For j = 2 To 4
LenS(j) = Len(Source(i, j).Text)
StartS(j) = Len(Temp) + 1
If LenS(j) > 0 Then Temp = Temp & Source(i, j).Text & " / "
Next j

Temp = Left(Temp, Len(Temp) + 3 * (Len(Temp) > 3))

With Target(i, 1)
.NumberFormat = "@"
.Value = Temp
.Characters(StartS(1), LenS(1)).Font.Color = vbBlue
.Characters(StartS(2), LenS(2)).Font.Color = vbGreen
.Characters(StartS(3), LenS(3)).Font.Color = vbBlack
.Characters(StartS(4), LenS(4)).Font.Color = vbRed
End With

Next i

End Sub

 

[Ron Rosenfeld]

Thanks Ron

*to anyone reading this!!!, as im sure its not just Ron*

The problem of getting rid of the / / / is proving to be a tedious one.
I have tried various ways to set each of the 4 sources to if else
statements and then assign that output to a variable to place in
Target1, but no joy. This is the Target1 string:

=====================================
Target1(i, 1).NumberFormat = "@"
If IsDate(Source1(i, 1)) Then
Target1(i, 1) = Format(Source1(i, 1), "dd/mm/yy") & " / " &
Format(Source2(i, 1), "dd/mm/yy") & " / " & Format(Source3(i, 1),
"dd/mm/yy") & " / " & Format(Source4(i, 1), "dd/mm/yy")
Else: Target1(i, 1) = ""
End If
=====================================

As you can see, if Source1 has a date and the other 3 Sources have
nothing, i'm left with unsightly / / /'s. What would be a logical
method for purging these please?

Regards,

Nick Payne-Roberts (UK, so might not reply tonight)

-*hopes that someone else other than Ron Rosenfeld replies, as he's
been the only person to give me feedback so far, and i'm feeling very
guilty (and grateful) for that.*-

Hmmm, I somehow missed that all of the columns in Source were dates. Try this
instead:

=========================================
Option Explicit

Sub CombineInitData()
Dim Source As Range
Dim Target As Range
Dim i As Long, j As Long
Dim LenS() As Long
Dim StartS() As Long
Dim Temp As String

Set Source = Worksheets("Data").Range("A216")
Set Target = Worksheets("Worksheet1").Range("A2:A16")
ReDim LenS(1 To Source.Columns.Count)
ReDim StartS(1 To Source.Columns.Count)

For i = 1 To Source.Rows.Count
Temp = ""
For j = 1 To Source.Columns.Count
LenS(j) = 0
If IsDate(Source(i, j)) Then
StartS(j) = Len(Temp) + 1
Temp = Temp & Format(Source(i, j), "dd/mm/yy") & " / "
LenS(j) = 8
End If
Next j

Temp = Left(Temp, Len(Temp) + 3 * (Len(Temp) > 3))

With Target(i, 1)
.NumberFormat = "@"
.Value = Temp
.Characters(StartS(1), LenS(1)).Font.Color = vbBlue
.Characters(StartS(2), LenS(2)).Font.Color = vbGreen
.Characters(StartS(3), LenS(3)).Font.Color = vbBlack
.Characters(StartS(4), LenS(4)).Font.Color = vbRed
End With

Next i

End Sub
===================================
--ron

 

[Ron Rosenfeld]

Thanks Ron

*to anyone reading this!!!, as im sure its not just Ron*

The problem of getting rid of the / / / is proving to be a tedious one.
I have tried various ways to set each of the 4 sources to if else
statements and then assign that output to a variable to place in
Target1, but no joy. This is the Target1 string:

=====================================
Target1(i, 1).NumberFormat = "@"
If IsDate(Source1(i, 1)) Then
Target1(i, 1) = Format(Source1(i, 1), "dd/mm/yy") & " / " &
Format(Source2(i, 1), "dd/mm/yy") & " / " & Format(Source3(i, 1),
"dd/mm/yy") & " / " & Format(Source4(i, 1), "dd/mm/yy")
Else: Target1(i, 1) = ""
End If
=====================================

As you can see, if Source1 has a date and the other 3 Sources have
nothing, i'm left with unsightly / / /'s. What would be a logical
method for purging these please?

Regards,

Nick Payne-Roberts (UK, so might not reply tonight)

-*hopes that someone else other than Ron Rosenfeld replies, as he's
been the only person to give me feedback so far, and i'm feeling very
guilty (and grateful) for that.*-

Here's a better one. Retains the color depending on the column position in
Source, and gets rid of those extra " / "'s

==================================
Sub CombineInitData()
Dim Source As Range
Dim Target As Range
Dim i As Long, j As Long, Start As Long
Dim Temp As String
Dim Colors()

Set Source = Worksheets("Data").Range("A216")
Set Target = Worksheets("Worksheet1").Range("A2:A16")
ReDim Colors(1 To Source.Columns.Count)

For i = 1 To Source.Rows.Count
Temp = ""
For j = 1 To Source.Columns.Count
If IsDate(Source(i, j)) Then
Temp = Temp & Format(Source(i, j), "dd/mm/yy") & " / "
Colors(j) = Switch(j = 1, vbBlue, j = 2, _
vbGreen, j = 3, vbBlack, j = 4, vbRed)
Else: Colors(j) = ""
End If
Next j
Temp = Left(Temp, Len(Temp) + (3 * (Len(Temp) > 3)))

With Target(i, 1)
Start = 1
.NumberFormat = "@"
.Value = Temp
For j = 1 To Source.Columns.Count
Select Case Len(Colors(j))
Case Is > 0
.Characters(Start, 8).Font.Color = Colors(j)
Start = Start + 11
End Select
Next j
End With
Next i

End Sub
==============================

--ron