EDIT:
I've fixed the problem. It turns out that it was picking a new word straight after the script below and was using the length of that word rather than the word I wanted it to use. My bad! Ignore this question if you're stumbling upon it just now.
on openCard
setup randomword
put randomword into fld "testfield"
end openCard
command test
put 11 into tNumObjs
put length(randomword) into tLen
repeat with x = 1 to tNumObjs
show fld ("letter"&x)
end repeat
end test
on setup pRandomWord
put 11 into tNumObjs
put length(pRandomWord) into tLen
repeat with x = 1 to tNumObjs
put empty into fld ("letter"&x)
hide fld ("letter"&x)
if x <= tLen then
put char x of pRandomWord into fld ("letter"&x)
show grc ("Line"&x)
else
hide grc ("Line" & x)
end if
end repeat
end setup
on checkForCharacterMatch pUserChar
local noMatch = true
repeat with N = 1 to (length(randomword))
put long id of field ("letter" & N) into theLetter
put long id of graphic ("Line" & N) into theLine
if (the text of theLetter = pUserChar) then
show theLetter
hide theLine
put false into noMatch
end if
end repeat
--if noMatch then
-- DO PENALTY STUFF HERE
--end if
end checkForCharacterMatch
My guess is that you have 11 fields for other purposes and the number of the first LetterN field is 12. Probably you used field numbers when you started writing your script but now you're using field names. Remove "+11" and it should work:
repeat with N = 1 to (length(randomword))
If this doesn't solve it, please explain why you add 11.
Related
How can I generate a string using vba that lets certain characters line up. As an example, lets say the strings generated over two rows are as follows:
"96 x $219.00 = $21,024.00"
"-8 x 45.00 = -360.00"
I want spaces added to the left of the rightmost number to have the "=" signs line up.
I also want spaces added to the left of the middle number to have the "x" character line up.
These strings are generated from a vba function.
I'm restricted to using Times-Roman Size 8 (company requirement, no negotiating)
Also, the string is to be right justified, in case someone is concerned.
After trying to extract the character width using Columns.ColumnWidth and comparing the widths of repeating a character say 10 and then 11 times (I tried other sets of numbers than these), then building a function to break down a string into characters and sum them, padding as described, the characters still don't line up. There should be a way to do this in vba. There are too many tables to fix by hand. Previous posting discussing just padding characters, fail to address how they are displayed.
Aligning text by inserting spaces is a terrible idea (word processing 101). Plus it is modifying the data, and as a user I would complain if I enter a=b into a cell and all of a sudden it is a=b.
Aligning text for a non-proportional font by adding spaces is impossible. You can only have a "best attempt" which approximately aligns them.
There is no build-in function in Excel (or VBA) to achieve this.
So, I did the following just for fun. Take it or leave it.
(1) There is no build in function for the text width of a string in VBA. If you google around, you can find different attempts, but one suggestion is rather easy to understand: Put a label on a user form, format it to the font you are interested in (eg Times New Roman, 8pt, Non-Bold, Non-Italic) and set properties AutoSize = True and .WordWrap = False.
When assigning any text to this label, it changes its size and you can read the width of it. Now this doesn't return the exact width of the text as the label uses some extra pixels to the left and right - but for our purposes we can ignore that.
So create a userform and put a label on it. Don't worry, you don't need to show the form, the resize of the label will be done even if the form is not displayed.
Now put the following code into a regular module:
Function GetTextWidth(s As String) As Double
Static f As UserForm1
If f Is Nothing Then Set f = New UserForm1
With f.Label1
.Font.Name = "Times New Roman"
.Font.Size = 8
.Font.Italic = False
.Font.Bold = False
.AutoSize = True
.WordWrap = False
.Caption = s
GetTextWidth = .Width
End With
End Function
(2)
Now we need to loop over all data (all cells of your range), split the text into the part left of the equation sign and the part right of it using split, calculate the word length for the left part and remember the length of the widest string.
(3)
Now we loop another time over all the data, again split the text, take the left part and add spaces to the left until the width is larger (or equal) than the max length we just calculated. If we reach the point, we check if this "nearer" to the max length or if we should go for one space left.
Code for Step 2 and 3:
Sub alignTextrange(r As Range, Optional alignChar As String = "=")
Const SpacesAroundAlignChar = 1
' First: Find widest string to the left of alignChar
Dim maxWidth As Double, currWidth As Double, prevWidth As Double
Dim leftWord As String
Dim cell As Range, tokens() As String
For Each cell In r
tokens = Split(cell.Value, alignChar)
If UBound(tokens) = 1 Then ' 2 pieces (like a = b)
leftWord = Trim(tokens(0))
currWidth = GetTextWidth(leftWord)
If currWidth > maxWidth Then maxWidth = currWidth
End If
Next
Debug.Print "Max: " & maxWidth
If maxWidth = 0 Then Exit Sub
' And now: Align all other cells to the one with the widest left string
For Each cell In r
tokens = Split(cell.Value, alignChar)
If UBound(tokens) = 1 Then ' 2 pieces (like a = b)
leftWord = Trim(tokens(0))
prevWidth = GetTextWidth(leftWord)
Dim i As Long
For i = 1 To 100
currWidth = GetTextWidth(Space(i) & leftWord)
Dim spacesNeeded As Long
If currWidth >= maxWidth Then
If maxWidth - prevWidth < currWidth - maxWidth Then
spacesNeeded = i - 1
Else
spacesNeeded = i
End If
cell = Space(spacesNeeded) & leftWord _
& Space(SpacesAroundAlignChar) & alignChar _
& Space(SpacesAroundAlignChar) & Trim(tokens(1))
Exit For
End If
prevWidth = currWidth
Next
End If
Next
End Sub
Of course there is room for improvement, like reading/writing the data into an array or to precalculate the width of several spaces, this should only show the rabbit hole you need to go down.
If this is not good enough then your only option is to go for spaces with a smaller font, but then it gets much more complicated. Or convince your bossed to get rid of this ugly font (or look for a new job).
(alignted is obviously a typo, too lazy to correct in my sheet and redo the screenshots).
I can grab every 2 chars from sum2.text in order (102030) i get 10,20,30
but my issue is, selecting exactly those numbers 10,20,30 in order
my current code below outputs: msgbox(10) msgbox(20) msgbox(30) but wont select and replace those exact numbers in order one by one
My code:
For i = 0 To sum2.Text.Length - 1 Step 2 'grabs every 2 chars
Dim result = (sum2.Text.Substring(i, 2)) 'this holds the 2 chars
MsgBox(result) 'this shows the 2 chars
sum2.SelectionStart = i 'this starts the selection at i
sum2.SelectionLength = 2 'this sets the length of selection (i)
If sum2.SelectedText.Contains("10") Then
sum2.SelectedText = sum2.SelectedText.Replace("10", "a")
End If
If sum2.SelectedText.Contains("20") Then
sum2.SelectedText = sum2.SelectedText.Replace("20", "b")
End If
If sum2.SelectedText.Contains("30") Then
sum2.SelectedText = sum2.SelectedText.Replace("30", "c")
End If
my probolem is that it will show the numbers in sum2 one by one correctly, but it would select and replace at all or one by one. I believe the issue is with the selection length
OK, here's my attempt from what I'm understanding you are wanting to do. The problem is, you are trying to alter the string that the loop is using when you replace "10" with "a" so you need to create a variable to hold your newly built string.
Dim part As String = ""
Dim fixed As String = ""
For i = 0 To Sum2.SelectedText.Length - 1 Step 2
part = Sum2.SelectedText.Substring(i, 2)
Select Case part
Case "10"
part = part.Replace("10", "a")
Case "20"
part = part.Replace("20", "b")
Case "30"
part = part.Replace("30", "c")
End Select
fixed &= part
Next
Sum2.SelectedText = fixed
Of course, this is only to show the workings of moving through the string and changing it. You would need to replace your selected text with the newly formatted result (fixed in this case)
Result: ab3077328732
Also, just so you know, if this format was such that no 2 digits would interfere, you could simply do a
sub2.selectedtext.replace("10", "a").Replace("20", "b").Replace...
However if you had 2 digits like 11 next to 05 it would fail to give desired results because if would change 1105 to 1a5. Just something to think about.
Here's some code to get you started:
For i = 0 To sum2.SelectedText.Length - 1 Step 2
MessageBox.Show(sum2.SelectedText.Substring(i, 2))
Next
I've made this large excel sheet and at the time i didn't know i'd need to sort this table through categories.
I have in a column (J here ) the description of the line and the category joint. (example: "Shipment of tires for usin'ss")
The only way i was able to sort the table the way i wanted was to build a category column using this :
=IF(COUNTIF(J3;"*usi*");"Usins";IF(COUNTIF(J3;"*remis*");"Remise";IF(COUNTIF(J3;"*oe*");"Oenols";IF(COUNTIF(J3;"*KDB*");"KDB";IF(COUNTIF(J3;"*vis*");"cvis";IF(COUNTIF(J3;"*amc*");"AMC";0))))))
usi for instance is a segment of a category name, that i sometimes wrote as
usin'ss
usin
usin's
usins
'cause you know smart.
Anyway, how do i translate =If(If(If...))) into something readable in VBA like:
If...then
If... then
Example of "IF ... ELSE" in EVBA
IF condition_1 THEN
'Instructions inside First IF Block
ELSEIF condition_2 Then
'Instructions inside ELSEIF Block
...
ELSEIF condition_n Then
'Instructions inside nth ELSEIF Block
ELSE
'Instructions inside Else Block
END IF
Example of Case Switch in EVBA
Select Case score
Case Is >= 90
result = "A"
Case Is >= 80
result = "B"
Case Is >= 70
result = "C"
Case Else
result = "Fail"
End Select
Both cases work off a waterfall type logic where if the first condition is met, then it does not continue, but if condition 1 is not met then it checks the next, etc.
Example usage:
Function makeASelectAction(vI_Score As Integer) As String
Select Case vI_Score
Case Is >= 90
makeASelectAction = "A, fantastic!"
Case Is >= 80
makeASelectAction = "B, not to shabby."
Case Is >= 70
makeASelectAction = "C... least your average"
Case Else
makeASelectAction = "Fail, nuff said."
End Select
End Function
Function makeAnIfAction(vS_Destination As String, vS_WhatToSay As String, Optional ovR_WhereToStick As Range, Optional ovI_TheScore As Integer)
If vS_Destination = "popup" Then
MsgBox (vS_WhatToSay)
ElseIf vS_Destination = "cell" Then
ovR_WhereToStick.value = vS_WhatToSay
ElseIf vS_Destination = "select" Then
MsgBox makeASelectAction(ovI_TheScore)
End If
End Function
Sub PopMeUp()
Call makeAnIfAction("popup", "Heyo!")
End Sub
Sub PopMeIn()
Call makeAnIfAction("cell", "Heyo!", Range("A4"))
End Sub
Sub MakeADescision()
Call makeAnIfAction(vS_Destination:="select" _
, vS_WhatToSay:="Heyo!" _
, ovI_TheScore:=80 _
)
End Sub
It will show you how to send variables to functions and how to call said function, it will show you how use optional parameters, how a function and interact with another function or sub, how do write a value to a sheet or spit out a messagebox. The possabilities are endless. Let me know if you need anything else cleared up or coded out.
You seem to be using CountIf just to see if the contents of the cell matches a certain pattern and, if so, give a replacement string. In VBA you can use the Like operator for pattern matching. In any event -- here is a function I wrote which, when passed a string and a series of pattern/substitution strings, loops through the patterns until it finds a match and then returns the corresponding substitution. If no match is found, it returns an optional default value (the last argument supplied). If no default is supplied, it returns #N/A.
The code illustrates that sometimes complicated nested ifs can be replaced by a loop which iterates through the various cases. This is helpful when you don't know the number of cases before hand.
Function ReplacePattern(s As String, ParamArray patterns()) As Variant
Dim i As Long, n As Long
n = UBound(patterns)
If n Mod 2 = 0 Then n = n - 1
For i = 0 To n Step 2
If s Like patterns(i) Then
ReplacePattern = patterns(i + 1)
Exit Function
End If
Next i
If UBound(patterns) Mod 2 = 0 Then
ReplacePattern = patterns(n + 1)
Else
ReplacePattern = CVErr(xlErrNA)
End If
End Function
Your spreadsheet formula is equivalent to
=ReplacePattern(J3,"*usi*","Usins","*remis*","Remise","*oe*","Oenols","*KDB*","KDB","*vis*","cvis","*amc*","AMC",0)
How to reduce time by this code?
TE is the variable that contains my text (contains more than 20000 lines)
and s is my search word.
repeat with x = 0 to the number of lines in TE
if line x of TE contains s then
put line x-1 of TE & cr & line x of TE & cr & line x+1 of TE & cr & cr after dataarray
end if
end repeat
This code works fine, but it take too much time.
How to reduce time?
Try to avoid the repeat with syntax as much as possible. Instead, use the repeat for eachsyntax:
put 0 into myLineNr
repeat for each line myLine in myData
// update counter
add 1 to myLineNr
if myLine contains mySearchString then
// store data in new variable
put line myLineNr - 1 of myData & cr & myLine & cr & line myLineNr + 1 of myData & cr & cr after myNewData
end if
end repeat
I have changed the script to allow for duplicate lines. This requires a counter, but using a counter is still faster than using the repeat with control structure.
I'm currently writing a function that dynamically composes a sql-query to retreive a number of posts and I've run into a smaller problem.
Pseudocode:
if trim$(sSqlQuery) <> "" then
sSqlQuery = "foo foo ) foo"
end if
if 1 = 1 then
sSqlQuery = sSqlQuery & "bar bar bar"
end if
This function returns the correct sql-query most of the time, but due to some circumstances in the earlier functions before this one, the second if-clause will be triggered. Resulting in weird query-results.
What i need to do is to figure out how to remove the last occurrence of ")" within sSqlQuery before it appends the second set of query to the total query within the second if-clause.
In pseudo I think it'd look something like this:
if 1 = 1 then
call removeLastOccurringStringFromString(sSqlQuery, ")")
sSqlQuery = sSqlQuery & "bar bar bar"
end if
However, i find it really hard to get a grasp on the Right() Left() and Mid() functions.
What I have tried is this:
nLen = InStrRev(sSqlSokUrval, ")") ' To get the positional value of the last ")"
After that i'm completely lost. Since if I substring this with Mid() i'll only get the ")" and nothing else.
Any thoughts and/or hint's on how to go about solving this will be highly appreciated! Thanks!
'Searches subject and removes last (and *only* last) occurence of the findstring
Function RemoveLastOccurenceOf(subject, findstring)
Dim pos
'Find last occurence of findstring
pos = InstrRev(subject, findstring, -1, vbBinaryCompare) 'use vbTextCompare for case-INsensitive search
if pos>0 then 'Found it?
'Take left of subject UP UNTIL the point where it was found
'...Skip length of findstring
'...Add rest of string
RemoveLastOccurenceOf = Left(subject, pos - 1) & Mid(subject, pos + len(findstring))
else 'Nope
'Return entire subject
RemoveLastOccurenceOf = subject
end if
End Function