PDA

View Full Version : [SOLVED:] "Translation" help for a bit of code (where year is identified)



jish
01-18-2024, 11:44 AM
Hi, Could someone please help “translate” into English what this bit of code below is doing (if that is easy to do)? The person who wrote it has left and I (who know next to nothing about coding) am trying to tweak the VBA code because the macro is no longer working correctly. I think the problem is that we combined years of a publication, so instead of labeling an embedded object in the worksheet as “…in 2019” we are trying to have it say “…in 2020-21,” for example. Currently it is returning things like "aho in 2 2020 and 2021 text" and I just can’t see where it is assigning the year. (We would like it to label the embedded icon as "Idaho in 2020-21 text." The code extracts that information for the place and year, I believe, from a title that appears on the first tab of the Excel workbook. Very magical, but also confusing. Have hundreds of embedded objects to name individually, so... Thanks for any help you can give!


' For every character in input string, copy digits to '
' return string. '
For l = 1 To Len(S)
If Mid(S, l, 1) >= "0" And Mid(S, l, 1) <= "9" Then
retval = retval + Mid(S, l, 1)
End If
Next
If Len(retval) = 8 Then
year = Left(retval, 4) & " and " & Right(retval, 4)
Else
If Len(retval) = 4 Then
year = retval & ""
Else
year = "Unsure"
End If
End If

'get the name for the embedded file
If InStr(1, ActiveCell.FormulaR1C1, "Cereal Industr") = 0 Then
newItem = Left(ActiveCell.FormulaR1C1, Len(ActiveCell.FormulaR1C1) - (4 + Len(year)))
newItem = newItem & " " & year & " Text"
Else
StrLen = Len(ActiveCell.FormulaR1C1)
str1 = Right(ActiveCell.FormulaR1C1, StrLen - (20 + Len(year)))
newItem = Left(str1, StrLen - (28 + Len(year)))
newItem = newItem & " " & year & " Text"
End If

georgiboy
01-19-2024, 01:00 AM
Could we see an example of the "title that appears on the first tab of the Excel workbook"?

The code can be explained but if we see an example of the above, there may be a simpler option.

jish
01-19-2024, 07:00 AM
Thank you for being willing to help! The title on the Excel spreadsheet is, essentially, “The Cereal Industry of Idaho in 2020 and 2021,” where the title is the same except for the State name.

The macro seems to be working fine now except for the naming of the embedded Word file. (That is, it grabs the Word file from elsewhere and embeds and names the embedded file---just with the truncated name.) I tried just typing in “2020-21” as a string in the macro and left off the word “text” to try to give it more room, but it still chops the name off. I’d like for the embedded object icon to be called something like “Idaho in 2020-2021 text” but it could be “Idaho in 2020-21,” if needed (and using the second item choice down in Excel’s list of icons---again, the macro is mostly doing everything fine now). Note that the place names are often somewhat longer than “Idaho.” I think the original macro was written so that the year wasn’t hard-coded, but I’d be fine with changing that manually from year to year---we’re backlogged and have several years’ worth to do.

Thank you, again!

georgiboy
01-19-2024, 08:13 AM
It depends on the variations of that title, the below may help:

Sub test()
Dim newItem As String

newItem = Replace(Replace(Replace(ActiveCell.Value, "The Cereal Industry of ", ""), ".", " text"), " and ", "-")

MsgBox newItem
End Sub

The below is the same as the above but broken down so you can see what it is doing:

Sub test()
Dim newItem As String

' only the first line below uses "ActiveCell.Value" as the value is then passed to "newItem" variable
newItem = Replace(ActiveCell.Value, "The Cereal Industry of ", "") ' replaces "The Cereal Industry of " from the activecell text with nothing
newItem = Replace(newItem, ".", " text") ' replaces the "." with the word " text" with a leading space
newItem = Replace(newItem, " and ", "-") ' replaces the " and " with a "-"

MsgBox newItem
End Sub

jish
01-19-2024, 08:35 AM
I'll give it a try and see what happens!

jish
01-19-2024, 08:48 AM
It works!!! I'm so happy. Thank you, georgiboy!!

georgiboy
01-19-2024, 08:53 AM
You're welcome.