Hi,

I need to create a VBA function which compares two cells to see if the
contents are anagrams of each other. Result of function would be true /
false.

The cells will only contain letters, and no letter will appear more
than 9 times. Each cell will never have any more than 40 characters in
total. Spaces can be ignored.

The logic I was planning to use was to assign every letter of the
alphabet a numeric value and then add up the numeric values of each
string to give a numeric result.

For this to produce a unique result for any given string, i was
planning to use values like the following:

a=1
b=1.1
c=1.01
d=1.001
e=1.0001
f=1.00001
g=10
h=10.1
i=10.01
j=10.001
k=10.0001
l=10.00001
m=100
n=100.1
o=100.01
p=100.001
q=100.0001
r=100.00001
s=1000
t=1000.1
u=1000.01
v=1000.001
w=1000.0001
x=1000.00001
y=10000
z=10000.1

Given that no letter can appear more than 9 times, I believe this
should return a unique result for every possible string of letters.

So, if the function compares two strings and gets the same addition
based on the above rules, the strings must contain the same letters and
are therefore anagrams of each other.

However, I have no idea how to code this in VBA.

Can anyone either suggest code for this, or another way of comparing
two strings to see if they are anagrams of each other?

Many thanks in advance,

Neil.

Any reason you cannot use the ASCII values of each character ? Or am I
missing something ?
I assumed you want all spaces removed.
Not sure how you want to handle "a" and "A", so included a "CaseSensitive"
argument you can toggle as required.
No checking that all values are actually in the alphabet. Also, if Unicode
is used, you will have to amend.

I think it gives the correct results, with a quick bit of testing.

Public Function AreAnagrams(ByVal String1 As Variant, ByVal String2 As
Variant, Optional CaseSensitive As Boolean = True) As Boolean
Dim Temp1() As Byte
Dim Temp2() As Byte

If CaseSensitive = False Then
'Change all to UCASE first
String1 = UCase(String1)
String2 = UCase(String2)
End If

'Remove any spaces
Temp1 = Replace(String1, " ", "")
Temp2 = Replace(String2, " ", "")

'See if they are the same length
If UBound(Temp1) <> UBound(Temp2) Then
AreAnagrams = False
Exit Function
End If

'Get the sum of the elment values in each
'If not equal, cannot be anagrams
AreAnagrams = (SumElements(Temp1) = SumElements(Temp2))

End Function

Private Function SumElements(argArr() As Byte) As Long
Dim i As Long

For i = LBound(argArr) To UBound(argArr)
SumElements = SumElements + argArr(i)
Next i

End Function

NickHK

"N Ramsay" <(E-Mail Removed)> wrote in message
news:(E-Mail Removed)...
> Hi,
>
> I need to create a VBA function which compares two cells to see if the
> contents are anagrams of each other. Result of function would be true /
> false.
>
> The cells will only contain letters, and no letter will appear more
> than 9 times. Each cell will never have any more than 40 characters in
> total. Spaces can be ignored.
>
> The logic I was planning to use was to assign every letter of the
> alphabet a numeric value and then add up the numeric values of each
> string to give a numeric result.
>
> For this to produce a unique result for any given string, i was
> planning to use values like the following:
>
> a=1
> b=1.1
> c=1.01
> d=1.001
> e=1.0001
> f=1.00001
> g=10
> h=10.1
> i=10.01
> j=10.001
> k=10.0001
> l=10.00001
> m=100
> n=100.1
> o=100.01
> p=100.001
> q=100.0001
> r=100.00001
> s=1000
> t=1000.1
> u=1000.01
> v=1000.001
> w=1000.0001
> x=1000.00001
> y=10000
> z=10000.1
>
> Given that no letter can appear more than 9 times, I believe this
> should return a unique result for every possible string of letters.
>
> So, if the function compares two strings and gets the same addition
> based on the above rules, the strings must contain the same letters and
> are therefore anagrams of each other.
>
> However, I have no idea how to code this in VBA.
>
> Can anyone either suggest code for this, or another way of comparing
> two strings to see if they are anagrams of each other?
>
> Many thanks in advance,
>
> Neil.
>

How about this as an alternative method?

Sub AnagramTest()

Dim Str1 As String
Dim Str2 As String
Dim i As Integer
Dim j As Integer

Str1 = "aaabbhbhh" ' populate these strings from somewhere
Str2 = "bbbhhhaaa"

If Len(Str1) <> Len(Str2) Then GoTo FailTest

For i = 1 To Len(Str1)
For j = 1 To Len(Str2)
If Mid(Str2, j, 1) = Mid(Str1, i, 1) Then
Str2 = Left(Str2, j - 1) & Right(Str2, Len(Str2) - j)
End If
Next j
Next i

If Len(Str2) > 0 Then
GoTo FailTest
Else
MsgBox "The two strings are anagrams of each other"
End If
Exit Sub

FailTest:
MsgBox "The two strings are not anagrams of each other"

End Sub




NickHK wrote:
> Any reason you cannot use the ASCII values of each character ? Or am I
> missing something ?
> I assumed you want all spaces removed.
> Not sure how you want to handle "a" and "A", so included a "CaseSensitive"
> argument you can toggle as required.
> No checking that all values are actually in the alphabet. Also, if Unicode
> is used, you will have to amend.
>
> I think it gives the correct results, with a quick bit of testing.
>
> Public Function AreAnagrams(ByVal String1 As Variant, ByVal String2 As
> Variant, Optional CaseSensitive As Boolean = True) As Boolean
> Dim Temp1() As Byte
> Dim Temp2() As Byte
>
> If CaseSensitive = False Then
> 'Change all to UCASE first
> String1 = UCase(String1)
> String2 = UCase(String2)
> End If
>
> 'Remove any spaces
> Temp1 = Replace(String1, " ", "")
> Temp2 = Replace(String2, " ", "")
>
> 'See if they are the same length
> If UBound(Temp1) <> UBound(Temp2) Then
> AreAnagrams = False
> Exit Function
> End If
>
> 'Get the sum of the elment values in each
> 'If not equal, cannot be anagrams
> AreAnagrams = (SumElements(Temp1) = SumElements(Temp2))
>
> End Function
>
> Private Function SumElements(argArr() As Byte) As Long
> Dim i As Long
>
> For i = LBound(argArr) To UBound(argArr)
> SumElements = SumElements + argArr(i)
> Next i
>
> End Function
>
> NickHK
>
> "N Ramsay" <(E-Mail Removed)> wrote in message
> news:(E-Mail Removed)...
> > Hi,
> >
> > I need to create a VBA function which compares two cells to see if the
> > contents are anagrams of each other. Result of function would be true /
> > false.
> >
> > The cells will only contain letters, and no letter will appear more
> > than 9 times. Each cell will never have any more than 40 characters in
> > total. Spaces can be ignored.
> >
> > The logic I was planning to use was to assign every letter of the
> > alphabet a numeric value and then add up the numeric values of each
> > string to give a numeric result.
> >
> > For this to produce a unique result for any given string, i was
> > planning to use values like the following:
> >
> > a=1
> > b=1.1
> > c=1.01
> > d=1.001
> > e=1.0001
> > f=1.00001
> > g=10
> > h=10.1
> > i=10.01
> > j=10.001
> > k=10.0001
> > l=10.00001
> > m=100
> > n=100.1
> > o=100.01
> > p=100.001
> > q=100.0001
> > r=100.00001
> > s=1000
> > t=1000.1
> > u=1000.01
> > v=1000.001
> > w=1000.0001
> > x=1000.00001
> > y=10000
> > z=10000.1
> >
> > Given that no letter can appear more than 9 times, I believe this
> > should return a unique result for every possible string of letters.
> >
> > So, if the function compares two strings and gets the same addition
> > based on the above rules, the strings must contain the same letters and
> > are therefore anagrams of each other.
> >
> > However, I have no idea how to code this in VBA.
> >
> > Can anyone either suggest code for this, or another way of comparing
> > two strings to see if they are anagrams of each other?
> >
> > Many thanks in advance,
> >
> > Neil.
> >

NickHK wrote:
> Any reason you cannot use the ASCII values of each character ? Or am I
> missing something ?

Hi Nick,

Thanks for the quick response!

The problem with using the ASCII values is that different values can
add up to the same result very easily.

eg ASCII value for "a" is 97, the ASCII for "b" is 98, "c"=99 and
"d"=100 etc...

so the sum of codes for "ad" = 97+100 = 197
and the sum of codes of "bc" = 98+99 = 197

Obviously "ad" is not an anagram of "bc", but the sum of their ACSII
codes is the same.

This is why i was assigning decimal values that cannot add up in this
way (assuming each letter appears less than 9 times).

Thanks,

Neil

Just realised I'm completely wrong here, so please ignore.
Time to start again....

NickHK

"NickHK" <(E-Mail Removed)> wrote in message
news:uo5X%(E-Mail Removed)...
> Any reason you cannot use the ASCII values of each character ? Or am I
> missing something ?
> I assumed you want all spaces removed.
> Not sure how you want to handle "a" and "A", so included a "CaseSensitive"
> argument you can toggle as required.
> No checking that all values are actually in the alphabet. Also, if Unicode
> is used, you will have to amend.
>
> I think it gives the correct results, with a quick bit of testing.
>
> Public Function AreAnagrams(ByVal String1 As Variant, ByVal String2 As
> Variant, Optional CaseSensitive As Boolean = True) As Boolean
> Dim Temp1() As Byte
> Dim Temp2() As Byte
>
> If CaseSensitive = False Then
> 'Change all to UCASE first
> String1 = UCase(String1)
> String2 = UCase(String2)
> End If
>
> 'Remove any spaces
> Temp1 = Replace(String1, " ", "")
> Temp2 = Replace(String2, " ", "")
>
> 'See if they are the same length
> If UBound(Temp1) <> UBound(Temp2) Then
> AreAnagrams = False
> Exit Function
> End If
>
> 'Get the sum of the elment values in each
> 'If not equal, cannot be anagrams
> AreAnagrams = (SumElements(Temp1) = SumElements(Temp2))
>
> End Function
>
> Private Function SumElements(argArr() As Byte) As Long
> Dim i As Long
>
> For i = LBound(argArr) To UBound(argArr)
> SumElements = SumElements + argArr(i)
> Next i
>
> End Function
>
> NickHK
>
> "N Ramsay" <(E-Mail Removed)> wrote in message
> news:(E-Mail Removed)...
> > Hi,
> >
> > I need to create a VBA function which compares two cells to see if the
> > contents are anagrams of each other. Result of function would be true /
> > false.
> >
> > The cells will only contain letters, and no letter will appear more
> > than 9 times. Each cell will never have any more than 40 characters in
> > total. Spaces can be ignored.
> >
> > The logic I was planning to use was to assign every letter of the
> > alphabet a numeric value and then add up the numeric values of each
> > string to give a numeric result.
> >
> > For this to produce a unique result for any given string, i was
> > planning to use values like the following:
> >
> > a=1
> > b=1.1
> > c=1.01
> > d=1.001
> > e=1.0001
> > f=1.00001
> > g=10
> > h=10.1
> > i=10.01
> > j=10.001
> > k=10.0001
> > l=10.00001
> > m=100
> > n=100.1
> > o=100.01
> > p=100.001
> > q=100.0001
> > r=100.00001
> > s=1000
> > t=1000.1
> > u=1000.01
> > v=1000.001
> > w=1000.0001
> > x=1000.00001
> > y=10000
> > z=10000.1
> >
> > Given that no letter can appear more than 9 times, I believe this
> > should return a unique result for every possible string of letters.
> >
> > So, if the function compares two strings and gets the same addition
> > based on the above rules, the strings must contain the same letters and
> > are therefore anagrams of each other.
> >
> > However, I have no idea how to code this in VBA.
> >
> > Can anyone either suggest code for this, or another way of comparing
> > two strings to see if they are anagrams of each other?
> >
> > Many thanks in advance,
> >
> > Neil.
> >
>
>

I don't think that the ASCII characters give unique answers

e.g. DDDD = CCEE if you simply sum the ASCII value


NickHK wrote:
> Any reason you cannot use the ASCII values of each character ? Or am I
> missing something ?
> I assumed you want all spaces removed.
> Not sure how you want to handle "a" and "A", so included a "CaseSensitive"
> argument you can toggle as required.
> No checking that all values are actually in the alphabet. Also, if Unicode
> is used, you will have to amend.
>
> I think it gives the correct results, with a quick bit of testing.
>
> Public Function AreAnagrams(ByVal String1 As Variant, ByVal String2 As
> Variant, Optional CaseSensitive As Boolean = True) As Boolean
> Dim Temp1() As Byte
> Dim Temp2() As Byte
>
> If CaseSensitive = False Then
> 'Change all to UCASE first
> String1 = UCase(String1)
> String2 = UCase(String2)
> End If
>
> 'Remove any spaces
> Temp1 = Replace(String1, " ", "")
> Temp2 = Replace(String2, " ", "")
>
> 'See if they are the same length
> If UBound(Temp1) <> UBound(Temp2) Then
> AreAnagrams = False
> Exit Function
> End If
>
> 'Get the sum of the elment values in each
> 'If not equal, cannot be anagrams
> AreAnagrams = (SumElements(Temp1) = SumElements(Temp2))
>
> End Function
>
> Private Function SumElements(argArr() As Byte) As Long
> Dim i As Long
>
> For i = LBound(argArr) To UBound(argArr)
> SumElements = SumElements + argArr(i)
> Next i
>
> End Function
>
> NickHK
>
> "N Ramsay" <(E-Mail Removed)> wrote in message
> news:(E-Mail Removed)...
> > Hi,
> >
> > I need to create a VBA function which compares two cells to see if the
> > contents are anagrams of each other. Result of function would be true /
> > false.
> >
> > The cells will only contain letters, and no letter will appear more
> > than 9 times. Each cell will never have any more than 40 characters in
> > total. Spaces can be ignored.
> >
> > The logic I was planning to use was to assign every letter of the
> > alphabet a numeric value and then add up the numeric values of each
> > string to give a numeric result.
> >
> > For this to produce a unique result for any given string, i was
> > planning to use values like the following:
> >
> > a=1
> > b=1.1
> > c=1.01
> > d=1.001
> > e=1.0001
> > f=1.00001
> > g=10
> > h=10.1
> > i=10.01
> > j=10.001
> > k=10.0001
> > l=10.00001
> > m=100
> > n=100.1
> > o=100.01
> > p=100.001
> > q=100.0001
> > r=100.00001
> > s=1000
> > t=1000.1
> > u=1000.01
> > v=1000.001
> > w=1000.0001
> > x=1000.00001
> > y=10000
> > z=10000.1
> >
> > Given that no letter can appear more than 9 times, I believe this
> > should return a unique result for every possible string of letters.
> >
> > So, if the function compares two strings and gets the same addition
> > based on the above rules, the strings must contain the same letters and
> > are therefore anagrams of each other.
> >
> > However, I have no idea how to code this in VBA.
> >
> > Can anyone either suggest code for this, or another way of comparing
> > two strings to see if they are anagrams of each other?
> >
> > Many thanks in advance,
> >
> > Neil.
> >

Okay, so as a function ...

Public Function AnagramTest(byval Str1 as String, byval Str2 as String)
as Boolean

Dim i As Integer
Dim j As Integer

If Len(Str1) <> Len(Str2) Then GoTo FailTest

For i = 1 To Len(Str1)
For j = 1 To Len(Str2)
If Mid(Str2, j, 1) = Mid(Str1, i, 1) Then
Str2 = Left(Str2, j - 1) & Right(Str2, Len(Str2) - j)
End If
Next j
Next i

If Len(Str2) > 0 Then
GoTo FailTest
Else
AnagramTest=TRUE
End If
Exit Function

FailTest:
AnagramTest=FALSE

End Function

This avoids all of the unique solution calculations by simply crossing
out letters.

Alan wrote:
> How about this as an alternative method?
>
> Sub AnagramTest()
>
> Dim Str1 As String
> Dim Str2 As String
> Dim i As Integer
> Dim j As Integer
>
> Str1 = "aaabbhbhh" ' populate these strings from somewhere
> Str2 = "bbbhhhaaa"
>
> If Len(Str1) <> Len(Str2) Then GoTo FailTest
>
> For i = 1 To Len(Str1)
> For j = 1 To Len(Str2)
> If Mid(Str2, j, 1) = Mid(Str1, i, 1) Then
> Str2 = Left(Str2, j - 1) & Right(Str2, Len(Str2) - j)
> End If
> Next j
> Next i
>
> If Len(Str2) > 0 Then
> GoTo FailTest
> Else
> MsgBox "The two strings are anagrams of each other"
> End If
> Exit Sub
>
> FailTest:
> MsgBox "The two strings are not anagrams of each other"
>
> End Sub
>
>
>
>
> NickHK wrote:
> > Any reason you cannot use the ASCII values of each character ? Or am I
> > missing something ?
> > I assumed you want all spaces removed.
> > Not sure how you want to handle "a" and "A", so included a "CaseSensitive"
> > argument you can toggle as required.
> > No checking that all values are actually in the alphabet. Also, if Unicode
> > is used, you will have to amend.
> >
> > I think it gives the correct results, with a quick bit of testing.
> >
> > Public Function AreAnagrams(ByVal String1 As Variant, ByVal String2 As
> > Variant, Optional CaseSensitive As Boolean = True) As Boolean
> > Dim Temp1() As Byte
> > Dim Temp2() As Byte
> >
> > If CaseSensitive = False Then
> > 'Change all to UCASE first
> > String1 = UCase(String1)
> > String2 = UCase(String2)
> > End If
> >
> > 'Remove any spaces
> > Temp1 = Replace(String1, " ", "")
> > Temp2 = Replace(String2, " ", "")
> >
> > 'See if they are the same length
> > If UBound(Temp1) <> UBound(Temp2) Then
> > AreAnagrams = False
> > Exit Function
> > End If
> >
> > 'Get the sum of the elment values in each
> > 'If not equal, cannot be anagrams
> > AreAnagrams = (SumElements(Temp1) = SumElements(Temp2))
> >
> > End Function
> >
> > Private Function SumElements(argArr() As Byte) As Long
> > Dim i As Long
> >
> > For i = LBound(argArr) To UBound(argArr)
> > SumElements = SumElements + argArr(i)
> > Next i
> >
> > End Function
> >
> > NickHK
> >
> > "N Ramsay" <(E-Mail Removed)> wrote in message
> > news:(E-Mail Removed)...
> > > Hi,
> > >
> > > I need to create a VBA function which compares two cells to see if the
> > > contents are anagrams of each other. Result of function would be true /
> > > false.
> > >
> > > The cells will only contain letters, and no letter will appear more
> > > than 9 times. Each cell will never have any more than 40 characters in
> > > total. Spaces can be ignored.
> > >
> > > The logic I was planning to use was to assign every letter of the
> > > alphabet a numeric value and then add up the numeric values of each
> > > string to give a numeric result.
> > >
> > > For this to produce a unique result for any given string, i was
> > > planning to use values like the following:
> > >
> > > a=1
> > > b=1.1
> > > c=1.01
> > > d=1.001
> > > e=1.0001
> > > f=1.00001
> > > g=10
> > > h=10.1
> > > i=10.01
> > > j=10.001
> > > k=10.0001
> > > l=10.00001
> > > m=100
> > > n=100.1
> > > o=100.01
> > > p=100.001
> > > q=100.0001
> > > r=100.00001
> > > s=1000
> > > t=1000.1
> > > u=1000.01
> > > v=1000.001
> > > w=1000.0001
> > > x=1000.00001
> > > y=10000
> > > z=10000.1
> > >
> > > Given that no letter can appear more than 9 times, I believe this
> > > should return a unique result for every possible string of letters.
> > >
> > > So, if the function compares two strings and gets the same addition
> > > based on the above rules, the strings must contain the same letters and
> > > are therefore anagrams of each other.
> > >
> > > However, I have no idea how to code this in VBA.
> > >
> > > Can anyone either suggest code for this, or another way of comparing
> > > two strings to see if they are anagrams of each other?
> > >
> > > Many thanks in advance,
> > >
> > > Neil.
> > >

Hi Neil,

I think your idea is OK, it's just easier to use the ASCII code values
to generate LONGs for each text value after removing spaces and
converting to Upper case.

Public Function ISANAGRAM(TEXT1 As String, TEXT2 As String) As Boolean
Application.Volatile
TEXT1 = Replace(TEXT1, " ", "")
TEXT2 = Replace(TEXT2, " ", "")
If Len(TEXT1) <> Len(TEXT2) Then
ISANAGRAM = False
Exit Function
End If
Dim i As Long
Dim lTEXT1_Value As Long
Dim lTEXT2_Value As Long
For i = 1 To Len(TEXT1)
lTEXT1_Value = lTEXT1_Value + 2 ^ (Asc(UCase(Mid(TEXT1, i, 1))) - 64)
lTEXT2_Value = lTEXT2_Value + 2 ^ (Asc(UCase(Mid(TEXT2, i, 1))) - 64)
Next i
If lTEXT1_Value = lTEXT2_Value Then
ISANAGRAM = True
Else: ISANAGRAM = False
End If
End Function

Ken Johnson

Yes, I wasn't thinking, hence my retraction.
Unfortunately, it remains visible to all..

NickHK

"N Ramsay" <(E-Mail Removed)> wrote in message
news:(E-Mail Removed)...
>
> NickHK wrote:
> > Any reason you cannot use the ASCII values of each character ? Or am I
> > missing something ?
>
> Hi Nick,
>
> Thanks for the quick response!
>
> The problem with using the ASCII values is that different values can
> add up to the same result very easily.
>
> eg ASCII value for "a" is 97, the ASCII for "b" is 98, "c"=99 and
> "d"=100 etc...
>
> so the sum of codes for "ad" = 97+100 = 197
> and the sum of codes of "bc" = 98+99 = 197
>
> Obviously "ad" is not an anagram of "bc", but the sum of their ACSII
> codes is the same.
>
> This is why i was assigning decimal values that cannot add up in this
> way (assuming each letter appears less than 9 times).
>
> Thanks,
>
> Neil
>

In a hope of retrieving some self respect, .....

Public Function AreAnagrams(ByVal String1 As Variant, ByVal String2 As
Variant, Optional CaseSensitive As Boolean = False) As Boolean
Dim i As Long
Dim j As Long
Dim HitPos As Long

'Remove any spaces
String1 = Replace(String1, " ", "")
String2 = Replace(String2, " ", "")

'See if they are the same length
If Len(String1) <> Len(String1) Then
AreAnagrams = False
Exit Function
End If

'Correct case if required
If CaseSensitive = False Then
String1 = UCase(String1)
String2 = UCase(String2)
End If

For i = 1 To Len(String1)
HitPos = InStr(1, String2, Mid(String1, i, 1), vbBinaryCompare)
'Debug.Print Mid(String1, i, 1), String2, HitPos
If HitPos = 0 Then
AreAnagrams = False
Exit Function
End If
Mid(String2, HitPos, 1) = " "
Next

AreAnagrams = True

End Function

NickHK

"N Ramsay" <(E-Mail Removed)> wrote in message
news:(E-Mail Removed)...
>
> NickHK wrote:
> > Any reason you cannot use the ASCII values of each character ? Or am I
> > missing something ?
>
> Hi Nick,
>
> Thanks for the quick response!
>
> The problem with using the ASCII values is that different values can
> add up to the same result very easily.
>
> eg ASCII value for "a" is 97, the ASCII for "b" is 98, "c"=99 and
> "d"=100 etc...
>
> so the sum of codes for "ad" = 97+100 = 197
> and the sum of codes of "bc" = 98+99 = 197
>
> Obviously "ad" is not an anagram of "bc", but the sum of their ACSII
> codes is the same.
>
> This is why i was assigning decimal values that cannot add up in this
> way (assuming each letter appears less than 9 times).
>
> Thanks,
>
> Neil
>