using excel to arrange letters on sign
 

I am looking for a way to use excel in changing the wording on the sign in
front of our church building. Every week we put up a new message. I pull the
letters for the person that changes the sign. I have to account for the
letters that are on the sign, pull the new letters needed while leaving the
ones that we will use again on the sign. There must be a way that I can
quickly use excel to tell me what new letters that I need.

using excel to arrange letters on sign
 

Here's how I would set it up.

First, set an area of cells to represent your sign, using 1 cell per letter.
I know its not convenient for typing, but the formulas will work easier, and
it will help with alignment planning of your sign. Lets assume A1:G3. This
area will be for whatever the old message was.

Assign area A4:G7 to the new sign message.

Now, a list of all the letters/character you have available. I'll assume
they're in I1:I50

Ok, in J1, type
=COUNTIF($A$1:$G$3,I1)
In K1
=COUNTIF($A$4:$G$7,I1)
In L1
=K1-J1

Copy these cells down to row 50. Now, column L will tell you what changes
you need. A positive number means you need to bring more of that symbol.
Negative number means you already have enough, and some to spare.

Hope this at least gives you some ideas as to how to build your workbook.
--
Best Regards,

Luke M
*Remember to click "yes" if this post helped you!*


"Bajohn56345" wrote:

I am looking for a way to use excel in changing the wording on the sign in
front of our church building. Every week we put up a new message. I pull the
letters for the person that changes the sign. I have to account for the
letters that are on the sign, pull the new letters needed while leaving the
ones that we will use again on the sign. There must be a way that I can
quickly use excel to tell me what new letters that I need.

using excel to arrange letters on sign
 

Hi,

Suppose you enter the old message in cell B1 and the new message in cell A1.
Next enter the full alphabet, in this example in lower case, in cells F1:F26.

In cell H1 enter
=SUMPRODUCT(LEN(A$2)-LEN(SUBSTITUTE(LOWER(A$2),$F1,"")))
in cell J1 enter
=SUMPRODUCT(LEN(B$2)-LEN(SUBSTITUTE(LOWER(B$2),$F1,"")))
in cell I1 enter
=IF(H1G1,H1-G1,"")

Copy these formulas down to row 26 and you will have the number of each
letter you need to add.

You could fancy up the last formula to read
=IF(H1G1,"Add "&H1-G1&" "&F1,IF(H1=G1,"","Remove "&G1-H1&" "&F1))
--
If this helps, please click the Yes button

Cheers,
Shane Devenshire


"Bajohn56345" wrote:

I am looking for a way to use excel in changing the wording on the sign in
front of our church building. Every week we put up a new message. I pull the
letters for the person that changes the sign. I have to account for the
letters that are on the sign, pull the new letters needed while leaving the
ones that we will use again on the sign. There must be a way that I can
quickly use excel to tell me what new letters that I need.

using excel to arrange letters on sign
 

What type of letters would be used?

Commas or semi-colons or the like?

Any numbers involved?

Dates like 1/3/2009 with slashes?

I have a macro for listing and counting characters that would probably suit
if you wanted to go that route.

Requires a cell with last week's message and a cell with this week's
message.


Gord Dibben MS Excel MVP



On Fri, 6 Feb 2009 08:55:27 -0800, Bajohn56345
wrote:

I am looking for a way to use excel in changing the wording on the sign in
front of our church building. Every week we put up a new message. I pull the
letters for the person that changes the sign. I have to account for the
letters that are on the sign, pull the new letters needed while leaving the
ones that we will use again on the sign. There must be a way that I can
quickly use excel to tell me what new letters that I need.

using excel to arrange letters on sign
 

If I did everything correctly (and I think I did<g), the macro below should
create two lists for you... one telling you which characters, and how many
of them, need to be removed from the sign board; and a second one telling
which characters, and how many of them, need to be added to the sign
board... those letters common to both messages will be left on the sign
board. To install the macro, press Alt+F11 to go into the VB editor, click
Insert/Module from its menu bar, and then copy/paste the macro into the code
window that appears. To use, first change the four Const statements to
reflect your actual set up. I have assume in my example Const statements
that the worksheet name is Sheet2, the text for the old (existing) message
is in A1, the text for the new message is in A2 and the first of the output
lists will start in A4 and the second list will start in the cell below that
one (and the lists will be entered into individual cells, from left to
right, cell by cell, along each list's row).

Sub LetterNeededForSignChange()
Dim X As Long
Dim OldMessage As String
Dim NewMessage As String
Dim Add() As String
Dim Remove() As String
Dim OldLetters(32 To 126) As Long
Dim NewLetters(32 To 126) As Long

Const SheetName As String = "Sheet2"
Const OldMessageCell As String = "A1"
Const NewMessageCell As String = "A2"
Const OutputCell As String = "A4"

ReDim Add(0)
ReDim Remove(0)
Add(0) = "Add ="
Remove(0) = "Remove ="
With Worksheets(SheetName)
OldMessage = .Range(OldMessageCell).Value
NewMessage = .Range(NewMessageCell).Value
For X = 1 To Len(OldMessage)
OldLetters(Asc(Mid(OldMessage, X, 1))) = _
OldLetters(Asc(Mid(OldMessage, X, 1))) + 1
Next
For X = 1 To Len(NewMessage)
NewLetters(Asc(Mid(NewMessage, X, 1))) = _
NewLetters(Asc(Mid(NewMessage, X, 1))) + 1
Next
For X = 33 To 126
If NewLetters(X) < OldLetters(X) Then
ReDim Preserve Remove(UBound(Remove) + 1)
Remove(UBound(Remove)) = Abs(NewLetters(X) - OldLetters(X)) & _
"-" & Chr(X)
ElseIf NewLetters(X) OldLetters(X) Then
ReDim Preserve Add(UBound(Add) + 1)
Add(UBound(Add)) = (NewLetters(X) - OldLetters(X)) & _
"-" & Chr(X)
End If
Next
For X = 0 To UBound(Remove)
.Range(OutputCell).Offset(, X).Value = Remove(X)
Next
For X = 0 To UBound(Add)
.Range(OutputCell).Offset(1, X).Value = Add(X)
Next
End With
End Sub

--
Rick (MVP - Excel)


"Bajohn56345" wrote in message
...
I am looking for a way to use excel in changing the wording on the sign in
front of our church building. Every week we put up a new message. I pull
the
letters for the person that changes the sign. I have to account for the
letters that are on the sign, pull the new letters needed while leaving
the
ones that we will use again on the sign. There must be a way that I can
quickly use excel to tell me what new letters that I need.

using excel to arrange letters on sign
 

Just to point out a couple of additional things. The code treats upper case
letters separately from lower case letters; plus if handles punctuation
marks as well. Also, if you leave the cell that contains the old message
blank, the code will give you a count of each character used in the
message... this might come in handy if you are worried that your message may
be using more of one character than you have physically letters for and you
want to check this out.

--
Rick (MVP - Excel)


"Rick Rothstein" wrote in message
...
If I did everything correctly (and I think I did<g), the macro below
should create two lists for you... one telling you which characters, and
how many of them, need to be removed from the sign board; and a second one
telling which characters, and how many of them, need to be added to the
sign board... those letters common to both messages will be left on the
sign board. To install the macro, press Alt+F11 to go into the VB editor,
click Insert/Module from its menu bar, and then copy/paste the macro into
the code window that appears. To use, first change the four Const
statements to reflect your actual set up. I have assume in my example
Const statements that the worksheet name is Sheet2, the text for the old
(existing) message is in A1, the text for the new message is in A2 and the
first of the output lists will start in A4 and the second list will start
in the cell below that one (and the lists will be entered into individual
cells, from left to right, cell by cell, along each list's row).

Sub LetterNeededForSignChange()
Dim X As Long
Dim OldMessage As String
Dim NewMessage As String
Dim Add() As String
Dim Remove() As String
Dim OldLetters(32 To 126) As Long
Dim NewLetters(32 To 126) As Long

Const SheetName As String = "Sheet2"
Const OldMessageCell As String = "A1"
Const NewMessageCell As String = "A2"
Const OutputCell As String = "A4"

ReDim Add(0)
ReDim Remove(0)
Add(0) = "Add ="
Remove(0) = "Remove ="
With Worksheets(SheetName)
OldMessage = .Range(OldMessageCell).Value
NewMessage = .Range(NewMessageCell).Value
For X = 1 To Len(OldMessage)
OldLetters(Asc(Mid(OldMessage, X, 1))) = _
OldLetters(Asc(Mid(OldMessage, X, 1))) + 1
Next
For X = 1 To Len(NewMessage)
NewLetters(Asc(Mid(NewMessage, X, 1))) = _
NewLetters(Asc(Mid(NewMessage, X, 1))) + 1
Next
For X = 33 To 126
If NewLetters(X) < OldLetters(X) Then
ReDim Preserve Remove(UBound(Remove) + 1)
Remove(UBound(Remove)) = Abs(NewLetters(X) - OldLetters(X)) & _
"-" & Chr(X)
ElseIf NewLetters(X) OldLetters(X) Then
ReDim Preserve Add(UBound(Add) + 1)
Add(UBound(Add)) = (NewLetters(X) - OldLetters(X)) & _
"-" & Chr(X)
End If
Next
For X = 0 To UBound(Remove)
.Range(OutputCell).Offset(, X).Value = Remove(X)
Next
For X = 0 To UBound(Add)
.Range(OutputCell).Offset(1, X).Value = Add(X)
Next
End With
End Sub

--
Rick (MVP - Excel)


"Bajohn56345" wrote in message
...
I am looking for a way to use excel in changing the wording on the sign in
front of our church building. Every week we put up a new message. I pull
the
letters for the person that changes the sign. I have to account for the
letters that are on the sign, pull the new letters needed while leaving
the
ones that we will use again on the sign. There must be a way that I can
quickly use excel to tell me what new letters that I need.

using excel to arrange letters on sign
 

Pretty slick Rick

But it breaks down when there are numbers in the message.

Try it with something like.

On Sunday February 8th we will be discussing John 3:7

Numbers are defaulted to dates.

I added a format line...................

With Worksheets(SheetName)

Rows("4:5").NumberFormat = "@" '<--------------added line

OldMessage = .Range(OldMessageCell).Value
NewMessage = .Range(NewMessageCell).Value

Any other way to stop the default to dates?


Gord


On Fri, 6 Feb 2009 19:43:28 -0500, "Rick Rothstein"
wrote:

If I did everything correctly (and I think I did<g), the macro below should
create two lists for you... one telling you which characters, and how many
of them, need to be removed from the sign board; and a second one telling
which characters, and how many of them, need to be added to the sign
board... those letters common to both messages will be left on the sign
board. To install the macro, press Alt+F11 to go into the VB editor, click
Insert/Module from its menu bar, and then copy/paste the macro into the code
window that appears. To use, first change the four Const statements to
reflect your actual set up. I have assume in my example Const statements
that the worksheet name is Sheet2, the text for the old (existing) message
is in A1, the text for the new message is in A2 and the first of the output
lists will start in A4 and the second list will start in the cell below that
one (and the lists will be entered into individual cells, from left to
right, cell by cell, along each list's row).

Sub LetterNeededForSignChange()
Dim X As Long
Dim OldMessage As String
Dim NewMessage As String
Dim Add() As String
Dim Remove() As String
Dim OldLetters(32 To 126) As Long
Dim NewLetters(32 To 126) As Long

Const SheetName As String = "Sheet2"
Const OldMessageCell As String = "A1"
Const NewMessageCell As String = "A2"
Const OutputCell As String = "A4"

ReDim Add(0)
ReDim Remove(0)
Add(0) = "Add ="
Remove(0) = "Remove ="
With Worksheets(SheetName)
OldMessage = .Range(OldMessageCell).Value
NewMessage = .Range(NewMessageCell).Value
For X = 1 To Len(OldMessage)
OldLetters(Asc(Mid(OldMessage, X, 1))) = _
OldLetters(Asc(Mid(OldMessage, X, 1))) + 1
Next
For X = 1 To Len(NewMessage)
NewLetters(Asc(Mid(NewMessage, X, 1))) = _
NewLetters(Asc(Mid(NewMessage, X, 1))) + 1
Next
For X = 33 To 126
If NewLetters(X) < OldLetters(X) Then
ReDim Preserve Remove(UBound(Remove) + 1)
Remove(UBound(Remove)) = Abs(NewLetters(X) - OldLetters(X)) & _
"-" & Chr(X)
ElseIf NewLetters(X) OldLetters(X) Then
ReDim Preserve Add(UBound(Add) + 1)
Add(UBound(Add)) = (NewLetters(X) - OldLetters(X)) & _
"-" & Chr(X)
End If
Next
For X = 0 To UBound(Remove)
.Range(OutputCell).Offset(, X).Value = Remove(X)
Next
For X = 0 To UBound(Add)
.Range(OutputCell).Offset(1, X).Value = Add(X)
Next
End With
End Sub

using excel to arrange letters on sign
 

Thanks! And good catch! That is what I get for testing with letters only.<g

I decided to make a couple of changes to the macro, one of which handles the
problem you mentioned. Originally, I just changed the output to add an
apostrophe in front of the cell's content... that stopped the date problem.
But then I decided the output for numbers might be confusing. For example,
if you see this, 4-3, it might take a moment to realize that there are 4
threes and not 3 fours. Anyway, I decided to put quote marks around the
character in order to emphasize it... that solved the date problem and made
reading the results easier (IMHO). Next, I decided by going across the row,
the column widths made it hard to read all the differences if there were a
lot of them, so I changed the print out orientation to "down the column"
instead of "across the row". This has the side benefit of allowing more than
254 differences (in case the messages are quite long). Here is the revised
code...

Sub LetterNeededForSignChange()
Dim X As Long
Dim OldMessage As String
Dim NewMessage As String
Dim Add() As String
Dim Remove() As String
Dim OldLetters(32 To 126) As Long
Dim NewLetters(32 To 126) As Long

Const SheetName As String = "Sheet2"
Const OldMessageCell As String = "A1"
Const NewMessageCell As String = "A2"
Const OutputCell As String = "A4"

ReDim Add(0)
ReDim Remove(0)
Add(0) = "Add"
Remove(0) = "Remove"
With Worksheets(SheetName)
OldMessage = .Range(OldMessageCell).Value
NewMessage = .Range(NewMessageCell).Value
For X = 1 To Len(OldMessage)
OldLetters(Asc(Mid(OldMessage, X, 1))) = _
OldLetters(Asc(Mid(OldMessage, X, 1))) + 1
Next
For X = 1 To Len(NewMessage)
NewLetters(Asc(Mid(NewMessage, X, 1))) = _
NewLetters(Asc(Mid(NewMessage, X, 1))) + 1
Next
For X = 33 To 126
If NewLetters(X) < OldLetters(X) Then
ReDim Preserve Remove(UBound(Remove) + 1)
Remove(UBound(Remove)) = Abs(NewLetters(X) - OldLetters(X)) & _
" - """ & Chr(X) & """"
ElseIf NewLetters(X) OldLetters(X) Then
ReDim Preserve Add(UBound(Add) + 1)
Add(UBound(Add)) = (NewLetters(X) - OldLetters(X)) & _
" - """ & Chr(X) & """"
End If
Next
.Range(OutputCell).Resize(5000, 2).Clear
For X = 0 To UBound(Remove)
.Range(OutputCell).Offset(X).Value = Remove(X)
Next
For X = 0 To UBound(Add)
.Range(OutputCell).Offset(X, 1).Value = Add(X)
Next
Range(OutputCell).Resize(1, 2).Font.Underline = True
End With
End Sub

--
Rick (MVP - Excel)


"Gord Dibben" <gorddibbATshawDOTca wrote in message
...
Pretty slick Rick

But it breaks down when there are numbers in the message.

Try it with something like.

On Sunday February 8th we will be discussing John 3:7

Numbers are defaulted to dates.

I added a format line...................

With Worksheets(SheetName)

Rows("4:5").NumberFormat = "@" '<--------------added line

OldMessage = .Range(OldMessageCell).Value
NewMessage = .Range(NewMessageCell).Value

Any other way to stop the default to dates?


Gord


On Fri, 6 Feb 2009 19:43:28 -0500, "Rick Rothstein"
wrote:

If I did everything correctly (and I think I did<g), the macro below
should
create two lists for you... one telling you which characters, and how many
of them, need to be removed from the sign board; and a second one telling
which characters, and how many of them, need to be added to the sign
board... those letters common to both messages will be left on the sign
board. To install the macro, press Alt+F11 to go into the VB editor, click
Insert/Module from its menu bar, and then copy/paste the macro into the
code
window that appears. To use, first change the four Const statements to
reflect your actual set up. I have assume in my example Const statements
that the worksheet name is Sheet2, the text for the old (existing) message
is in A1, the text for the new message is in A2 and the first of the
output
lists will start in A4 and the second list will start in the cell below
that
one (and the lists will be entered into individual cells, from left to
right, cell by cell, along each list's row).

Sub LetterNeededForSignChange()
Dim X As Long
Dim OldMessage As String
Dim NewMessage As String
Dim Add() As String
Dim Remove() As String
Dim OldLetters(32 To 126) As Long
Dim NewLetters(32 To 126) As Long

Const SheetName As String = "Sheet2"
Const OldMessageCell As String = "A1"
Const NewMessageCell As String = "A2"
Const OutputCell As String = "A4"

ReDim Add(0)
ReDim Remove(0)
Add(0) = "Add ="
Remove(0) = "Remove ="
With Worksheets(SheetName)
OldMessage = .Range(OldMessageCell).Value
NewMessage = .Range(NewMessageCell).Value
For X = 1 To Len(OldMessage)
OldLetters(Asc(Mid(OldMessage, X, 1))) = _
OldLetters(Asc(Mid(OldMessage, X, 1))) + 1
Next
For X = 1 To Len(NewMessage)
NewLetters(Asc(Mid(NewMessage, X, 1))) = _
NewLetters(Asc(Mid(NewMessage, X, 1))) + 1
Next
For X = 33 To 126
If NewLetters(X) < OldLetters(X) Then
ReDim Preserve Remove(UBound(Remove) + 1)
Remove(UBound(Remove)) = Abs(NewLetters(X) - OldLetters(X)) & _
"-" & Chr(X)
ElseIf NewLetters(X) OldLetters(X) Then
ReDim Preserve Add(UBound(Add) + 1)
Add(UBound(Add)) = (NewLetters(X) - OldLetters(X)) & _
"-" & Chr(X)
End If
Next
For X = 0 To UBound(Remove)
.Range(OutputCell).Offset(, X).Value = Remove(X)
Next
For X = 0 To UBound(Add)
.Range(OutputCell).Offset(1, X).Value = Add(X)
Next
End With
End Sub

using excel to arrange letters on sign
 

Excellent revision.

I am sure this exercise will help OP and anyone else needing similar
operation.

A keeper.


Gord

On Sat, 7 Feb 2009 13:16:09 -0500, "Rick Rothstein"
wrote:

Thanks! And good catch! That is what I get for testing with letters only.<g

I decided to make a couple of changes to the macro, one of which handles the
problem you mentioned. Originally, I just changed the output to add an
apostrophe in front of the cell's content... that stopped the date problem.
But then I decided the output for numbers might be confusing. For example,
if you see this, 4-3, it might take a moment to realize that there are 4
threes and not 3 fours. Anyway, I decided to put quote marks around the
character in order to emphasize it... that solved the date problem and made
reading the results easier (IMHO). Next, I decided by going across the row,
the column widths made it hard to read all the differences if there were a
lot of them, so I changed the print out orientation to "down the column"
instead of "across the row". This has the side benefit of allowing more than
254 differences (in case the messages are quite long). Here is the revised
code...

Sub LetterNeededForSignChange()
Dim X As Long
Dim OldMessage As String
Dim NewMessage As String
Dim Add() As String
Dim Remove() As String
Dim OldLetters(32 To 126) As Long
Dim NewLetters(32 To 126) As Long

Const SheetName As String = "Sheet2"
Const OldMessageCell As String = "A1"
Const NewMessageCell As String = "A2"
Const OutputCell As String = "A4"

ReDim Add(0)
ReDim Remove(0)
Add(0) = "Add"
Remove(0) = "Remove"
With Worksheets(SheetName)
OldMessage = .Range(OldMessageCell).Value
NewMessage = .Range(NewMessageCell).Value
For X = 1 To Len(OldMessage)
OldLetters(Asc(Mid(OldMessage, X, 1))) = _
OldLetters(Asc(Mid(OldMessage, X, 1))) + 1
Next
For X = 1 To Len(NewMessage)
NewLetters(Asc(Mid(NewMessage, X, 1))) = _
NewLetters(Asc(Mid(NewMessage, X, 1))) + 1
Next
For X = 33 To 126
If NewLetters(X) < OldLetters(X) Then
ReDim Preserve Remove(UBound(Remove) + 1)
Remove(UBound(Remove)) = Abs(NewLetters(X) - OldLetters(X)) & _
" - """ & Chr(X) & """"
ElseIf NewLetters(X) OldLetters(X) Then
ReDim Preserve Add(UBound(Add) + 1)
Add(UBound(Add)) = (NewLetters(X) - OldLetters(X)) & _
" - """ & Chr(X) & """"
End If
Next
.Range(OutputCell).Resize(5000, 2).Clear
For X = 0 To UBound(Remove)
.Range(OutputCell).Offset(X).Value = Remove(X)
Next
For X = 0 To UBound(Add)
.Range(OutputCell).Offset(X, 1).Value = Add(X)
Next
Range(OutputCell).Resize(1, 2).Font.Underline = True
End With
End Sub

using excel to arrange letters on sign
 

Thanks for the nice comments. This was a fun exercise... these are the kinds
of questions I just love to answer.

--
Rick (MVP - Excel)


"Gord Dibben" <gorddibbATshawDOTca wrote in message
...
Excellent revision.

I am sure this exercise will help OP and anyone else needing similar
operation.

A keeper.


Gord

On Sat, 7 Feb 2009 13:16:09 -0500, "Rick Rothstein"
wrote:

Thanks! And good catch! That is what I get for testing with letters
only.<g

I decided to make a couple of changes to the macro, one of which handles
the
problem you mentioned. Originally, I just changed the output to add an
apostrophe in front of the cell's content... that stopped the date
problem.
But then I decided the output for numbers might be confusing. For example,
if you see this, 4-3, it might take a moment to realize that there are 4
threes and not 3 fours. Anyway, I decided to put quote marks around the
character in order to emphasize it... that solved the date problem and
made
reading the results easier (IMHO). Next, I decided by going across the
row,
the column widths made it hard to read all the differences if there were a
lot of them, so I changed the print out orientation to "down the column"
instead of "across the row". This has the side benefit of allowing more
than
254 differences (in case the messages are quite long). Here is the revised
code...

Sub LetterNeededForSignChange()
Dim X As Long
Dim OldMessage As String
Dim NewMessage As String
Dim Add() As String
Dim Remove() As String
Dim OldLetters(32 To 126) As Long
Dim NewLetters(32 To 126) As Long

Const SheetName As String = "Sheet2"
Const OldMessageCell As String = "A1"
Const NewMessageCell As String = "A2"
Const OutputCell As String = "A4"

ReDim Add(0)
ReDim Remove(0)
Add(0) = "Add"
Remove(0) = "Remove"
With Worksheets(SheetName)
OldMessage = .Range(OldMessageCell).Value
NewMessage = .Range(NewMessageCell).Value
For X = 1 To Len(OldMessage)
OldLetters(Asc(Mid(OldMessage, X, 1))) = _
OldLetters(Asc(Mid(OldMessage, X, 1))) + 1
Next
For X = 1 To Len(NewMessage)
NewLetters(Asc(Mid(NewMessage, X, 1))) = _
NewLetters(Asc(Mid(NewMessage, X, 1))) + 1
Next
For X = 33 To 126
If NewLetters(X) < OldLetters(X) Then
ReDim Preserve Remove(UBound(Remove) + 1)
Remove(UBound(Remove)) = Abs(NewLetters(X) - OldLetters(X)) & _
" - """ & Chr(X) & """"
ElseIf NewLetters(X) OldLetters(X) Then
ReDim Preserve Add(UBound(Add) + 1)
Add(UBound(Add)) = (NewLetters(X) - OldLetters(X)) & _
" - """ & Chr(X) & """"
End If
Next
.Range(OutputCell).Resize(5000, 2).Clear
For X = 0 To UBound(Remove)
.Range(OutputCell).Offset(X).Value = Remove(X)
Next
For X = 0 To UBound(Add)
.Range(OutputCell).Offset(X, 1).Value = Add(X)
Next
Range(OutputCell).Resize(1, 2).Font.Underline = True
End With
End Sub

using excel to arrange letters on sign
 

Nothing from the OP... I guess he is going to miss out on my solution. Too bad.

--
Rick (MVP - Excel)


"Gord Dibben" <gorddibbATshawDOTca wrote in message ...
Excellent revision.

I am sure this exercise will help OP and anyone else needing similar
operation.

A keeper.


Gord

On Sat, 7 Feb 2009 13:16:09 -0500, "Rick Rothstein"
wrote:

Thanks! And good catch! That is what I get for testing with letters only.<g

I decided to make a couple of changes to the macro, one of which handles the
problem you mentioned. Originally, I just changed the output to add an
apostrophe in front of the cell's content... that stopped the date problem.
But then I decided the output for numbers might be confusing. For example,
if you see this, 4-3, it might take a moment to realize that there are 4
threes and not 3 fours. Anyway, I decided to put quote marks around the
character in order to emphasize it... that solved the date problem and made
reading the results easier (IMHO). Next, I decided by going across the row,
the column widths made it hard to read all the differences if there were a
lot of them, so I changed the print out orientation to "down the column"
instead of "across the row". This has the side benefit of allowing more than
254 differences (in case the messages are quite long). Here is the revised
code...

Sub LetterNeededForSignChange()
Dim X As Long
Dim OldMessage As String
Dim NewMessage As String
Dim Add() As String
Dim Remove() As String
Dim OldLetters(32 To 126) As Long
Dim NewLetters(32 To 126) As Long

Const SheetName As String = "Sheet2"
Const OldMessageCell As String = "A1"
Const NewMessageCell As String = "A2"
Const OutputCell As String = "A4"

ReDim Add(0)
ReDim Remove(0)
Add(0) = "Add"
Remove(0) = "Remove"
With Worksheets(SheetName)
OldMessage = .Range(OldMessageCell).Value
NewMessage = .Range(NewMessageCell).Value
For X = 1 To Len(OldMessage)
OldLetters(Asc(Mid(OldMessage, X, 1))) = _
OldLetters(Asc(Mid(OldMessage, X, 1))) + 1
Next
For X = 1 To Len(NewMessage)
NewLetters(Asc(Mid(NewMessage, X, 1))) = _
NewLetters(Asc(Mid(NewMessage, X, 1))) + 1
Next
For X = 33 To 126
If NewLetters(X) < OldLetters(X) Then
ReDim Preserve Remove(UBound(Remove) + 1)
Remove(UBound(Remove)) = Abs(NewLetters(X) - OldLetters(X)) & _
" - """ & Chr(X) & """"
ElseIf NewLetters(X) OldLetters(X) Then
ReDim Preserve Add(UBound(Add) + 1)
Add(UBound(Add)) = (NewLetters(X) - OldLetters(X)) & _
" - """ & Chr(X) & """"
End If
Next
.Range(OutputCell).Resize(5000, 2).Clear
For X = 0 To UBound(Remove)
.Range(OutputCell).Offset(X).Value = Remove(X)
Next
For X = 0 To UBound(Add)
.Range(OutputCell).Offset(X, 1).Value = Add(X)
Next
Range(OutputCell).Resize(1, 2).Font.Underline = True
End With
End Sub