Macro Practice III

Macro Practice Part III

Macro Practice IIIHopefully I can finish this topic today because I have only 2 more macros to talk about and then I’m at the end of what I have figured out. The last post stopped at separating out the individual letters so that the letters could be counted. The next macro I’m going to talk about is the one to list all of the one letter words, all of the two letter words, all of the three letter words, and so on into rows 18 through 32. The macro searches row by row, and word by word in rows 1 through 14 and then lists the appropriate words next to the 1 letter, 2 letter, 3 letter word designations in rows 18 to 32.

Note: This theme does not show the indentation for the If Then segments.

[ap_divider color=”#CCCCCC” style=”solid” thickness=”3px” width=”100%” mar_top=”20px” mar_bot=”20px”]

Counting Words Macro

Sub ListWords()

‘i = row where the phrase to be transformed
‘j = letter in the phrase

Sheets(“Decode”).Select

For i = 1 To 14
If Cells(i, 5) <> “” Then
For j = 1 To Cells(i, 1)
If Len(Cells(i, 4 + j)) = 1 Then
Range(“A18”).Select
Selection.End(xlToRight).Select
Selection.Cells(Row + 1, Column + 2).Select
ActiveCell = Cells(i, 4 + j)
End If
If Len(Cells(i, 4 + j)) = 2 Then
Range(“A19”).Select
Selection.End(xlToRight).Select
Selection.Cells(Row + 1, Column + 2).Select
ActiveCell = Cells(i, 4 + j)
End If
If Len(Cells(i, 4 + j)) = 3 Then
Range(“A20”).Select
Selection.End(xlToRight).Select
Selection.Cells(Row + 1, Column + 2).Select
ActiveCell = Cells(i, 4 + j)
…(continue on with 4, 5, 6….)


If Len(Cells(i, 4 + j)) = 14 Then
Range(“A31”).Select
Selection.End(xlToRight).Select
Selection.Cells(Row + 1, Column + 2).Select
ActiveCell = Cells(i, 4 + j)
End If
If Len(Cells(i, 4 + j)) = 15 Then
Range(“A32”).Select
Selection.End(xlToRight).Select
Selection.Cells(Row + 1, Column + 2).Select
ActiveCell = Cells(i, 4 + j)
End If
Next j
End If
Next i

MsgBox (“Program is done.”)
End Sub

[ap_divider color=”#CCCCCC” style=”solid” thickness=”3px” width=”100%” mar_top=”20px” mar_bot=”20px”]

So far, I have something that tells me how many times the encrypted letter appears (counting down in cells P19 through P44 via countif($E$85:$JC$98,”letter”); how many 1 letter words, 2 letter words, etc (cells B18 through B32 with formula countif($E$50:$AM$63,”number”); a listing of those words (cells D18 through L32 created by counting words macro), and how many words contain the encrypted letters (cells Q19 through Q44 with formula COUNTIF($E$1:$AM$14,”=*”&R44&”*”)). You might be able to download the embedded file in the last post to see how those formulas work.

My last macro is the “Decode” macro but it really doesn’t decode. What it does is replace the encrypted letters with my guess of what the decrypted letter should be. Cells R19 to R44 are the encrypted letters and cells S19 to S77 are where I enter what I think the decrypted letter should be, in order to decode the cryptographic phrases. The “Decode” macro takes my guess and replaces the encrypted letters in the phrase with my guess.

[ap_divider color=”#CCCCCC” style=”solid” thickness=”3px” width=”100%” mar_top=”20px” mar_bot=”20px”]

Decode Macro

Sub Decode()


‘  This macro first test each row in column E for words, and then goes letter by letter in each row, replacing each letter with its new code found in “Decode”.
‘  The code is found in columns R and S in “Decode”.
‘  This macro mimics the “Translate” macro that created the encrypted writings. “Decode” is to decrypt the encryption.

Dim oldletter As String
Dim newletter As String
Dim oldphrase As String
Dim newphrase As String

‘i = row where the phrase to be transformed
‘j = letter in the phrase

Sheets(“Decode”).Select
For i = 1 To 14
If Cells(99 + i, 5) <> “” Then
For j = 1 To Cells(99 + i, 1)
oldphrase = Left(Cells(99 + i, 5), j – 1)
oldletter = Mid(Cells(69 + i, 5), j, 1)
If oldletter <> ” ” Then
newletter = Application.WorksheetFunction.VLookup(oldletter, Sheets(“Decode”).Range(“R19:S46”), 2, False)
If newletter = “” Then
newletter = “-”
End If
newphrase = Replace(Cells(99 + i, 5), Mid(Cells(99 + i, 5), j, 1), newletter, j, 1)
Cells(99 + i, 5) = oldphrase & newphrase
End If
Next j
End If
Next i

MsgBox (“Program is done.”)
End Sub

[ap_divider color=”#CCCCCC” style=”solid” thickness=”3px” width=”100%” mar_top=”20px” mar_bot=”20px”]

And that “Decode” macro is where I last left off. While I can’t immediately use any of these macros for my work, I can envision that I might need it in the future if I ever have to deal with words.

So, now I’m off to work some more on this new theme.

Similar Posts