I may be asking a silly question but I am self teaching myself VBA and I am just stumped and I am not even sure what terms I can use to look up a solution.
I am writing a code that will compare three variables to three other variables then I want to display which variables have changed.
So if x = a but y <> b and z <> c then the output should be b/c
I have worked out a code that works fine
Dim Str As String
If X <> A Then
If Y <> B Then
If Z <> C Then
Str = "a/b/c"
Else
Str = "a/b"
End If
ElseIf Z <> C Then
Str = "a/c"
Else
Str = "a"
End If
ElseIf Y <> B Then
If Z <> C Then
Str = "b/c"
Else
Str = "b"
End If
Else
Str = "c"
End If
But as I increase the number of variables this becomes extremely complex very quickly.
If anyone can help direct me to a simpler method without the exponential complexity I would be very grateful.
Thank you all so much!
You need to test each variable pair independently from each other -- not link them together in one giant If construct tree.
Example:
str = "" 'Start with blank string. Append as required.
If x <> a Then str = str & "a/"
If y <> b Then str = str & "b/"
If z <> c Then str = str & "c/"
'Remove the extra / at the end
If Right(str, 1) = "/" Then str = Left(str, Len(str - 1))
You could put the 2 strings in 2 arrays, and then use a FOR...NEXT construct to loop both arrays. You can use UBound(arValues) to dynamically find out the number of items in the array.
Good luck
Related
I am manipulating strings.
I want the output string to be only between 2 specific characters (= and o)
I can do this by repeat this twice:
For f = 1 To Len(line5)
If Mid(line5, f, 1) = "=" Then
line5 = Mid(line5, f, Len(line5) - f + 1)
line5 = line5_out
End If
One time for = and one for o
Is there a quicker way to do this?
There are multiple ways to do it, the "best" way depends on what exactly you need.
Besides those comments, here are two more ways to do it:
'Delete everything behind o and infront of =
YourString = YourString.Remove(YourString.LastIndexOf("o") + 1, YourString.Length - YourString.LastIndexOf("o") - 1).Remove(0, YourString.IndexOf("="))
'Get part of string between = and o
YourString = YourString.Substring(IndexOf("="), YourString.LastIndexOf("o") + 1 - YourString.IndexOf("="))
I have a set which has an unknown number of objects. I want to associate a label to each one of these objects. Instead of labeling each object with a number I want to label them with letters.
For example the first object would be labeled A the second B and so on.
When I get to Z, the next object would be labeled AA
AZ? then BA, BB, BC.
ZZ? then AAA, AAB, AAC and so on.
I'm working using Mapbasic (similar to VBA), but I can't seem to wrap my head around a dynamic solution. My solution assumes that there will be a max number of objects that the set may or may not exceed.
label = pos1 & pos2
Once pos2 reaches ASCII "Z" then pos1 will be "A" and pos2 will be "A". However, if there is another object after "ZZ" this will fail.
How do I overcome this static solution?
Basically what I needed was a Base 26 Counter. The function takes a parameter like "A" or "AAA" and determines the next letter in the sequence.
Function IncrementAlpha(ByVal alpha As String) As String
Dim N As Integer
Dim num As Integer
Dim str As String
Do While Len(alpha)
num = num * 26 + (Asc(alpha) - Asc("A") + 1)
alpha = Mid$(alpha, 2,1)
Loop
N = num + 1
Do While N > 0
str = Chr$(Asc("A") + (N - 1) Mod 26) & str
N = (N - 1) \ 26
Loop
IncrementAlpha = str
End Function
If we need to convert numbers to a "letter format" where:
1 = A
26 = Z
27 = AA
702 = ZZ
703 = AAA etc
...and it needs to be in Excel VBA, then we're in luck. Excel's columns are "numbered" the same way!
Function numToLetters(num As Integer) As String
numToLetters = Split(Cells(1, num).Address(, 0), "$")(0)
End Function
Pass this function a number between 1 and 16384 and it will return a string between A and XFD.
Edit:
I guess I misread; you're not using Excel. If you're using VBA you should still be able to do this will the help of an reference to an Excel Object Library.
This should get you going in terms of the logic. Haven't tested it completely, but you should be able to work from here.
Public Function GenerateLabel(ByVal Number As Long) As String
Const TOKENS As String = "ZABCDEFGHIJKLMNOPQRSTUVWXY"
Dim i As Long
Dim j As Long
Dim Prev As String
j = 1
Prev = ""
Do While Number > 0
i = (Number Mod 26) + 1
GenerateLabel = Prev & Mid(TOKENS, i, 1)
Number = Number - 26
If j > 0 Then Prev = Mid(TOKENS, j + 1, 1)
j = j + Abs(Number Mod 26 = 0)
Loop
End Function
I'm putting together an excel spreadsheet for calculations, and I need to be able to show the formulas to go with the decisions, for the most part its pretty straight forward, but When I come to an 'if' formula in an excel cell, I don't want to show the value_if_true and value_if_false... Just the logical_test value.
Example:
Formula is: =if(and(5<=A1, A1<=10),"Pass", "Fail");
Result will be: "and(5<=A1, A1<=10)"
I need to be able to work with complex logical tests which may include nested if statements, so just splitting at the commas won't work reliably. Similarly the value_if_true and value_if_false statements could also contain if statements.
Any ideas?
If have clear understanding of what you asking for, then you can use something like this (shall be used only with IF() statement :
Function extrIf(ByVal ifstatement As Range) As String
Dim S$, sRev$, x%, k
S = Replace(Replace(ifstatement.Formula, "IF(", "\"), "),", ")|")
sRev = StrReverse(S)
If InStr(1, sRev, "|") > InStr(1, sRev, "\") Or InStr(1, sRev, "|") = 0 Then
x = InStr(1, StrReverse(Left(sRev, InStr(1, sRev, "\"))), ",") - 1
S = Mid(S, 1, Len(S) - InStr(1, sRev, "\") + x) & "|"
End If
sRev = ""
For Each k In Split(S, "|")
If k <> "" Then
If k Like "*\*" Then
sRev = sRev & ", " & Mid(k, InStr(1, k, "\") + 1, 999)
End If
End If
Next
extrIf = Mid(sRev, 3, 999)
End Function
example:
test:
Maybe this is not complete solution for you, but I think it might give you right direction.
If the cell formula starts with an If statement then you can return the logic test (starting after the first open parenthesis) by determining the position of the first comma where the sum of the previous open parenthesis - the sum previous closed = 0.
Formulas
Function ExtractIfTest(Target As Range) As String
Dim ch As String, s As String
Dim openP As Long
Dim x As Long
s = Target.formula
For x = 5 To Len(s)
ch = Mid(s, x, 1)
If Mid(s, x, 1) = "(" Then
openP = openP + 1
ElseIf Mid(s, x, 1) = ")" Then
openP = openP - 1
ElseIf Mid(s, x, 1) = "," And openP = 0 Then
ExtractIfTest = Mid(s, 5, x - 12)
End If
Next
End Function
Results
There might be instances where the is a comma without parenthesis A1,B1. If this happens simple escape them with parenthesis (A1,B1)
I've written an UDF that extract any of the parameters of the target formula. It's close to the one in Thomas answer, but more global and takes into account strings that can enclose commas or parenthesis.
Function ExtractFormulaParameter(Target As Range, Optional Position As Long = 1) As Variant
Dim inString As Boolean
Dim formula As String
Dim st As Long, sp As Long, i As Long, c As String
Dim parenthesis As Long, comma As Long
formula = Target.formula
st = 0: sp = 0
If Position <= 0 Then ExtractFormulaParameter = CVErr(xlErrValue): Exit Function
For i = 1 To Len(formula)
c = Mid$(formula, i, 1)
If inString Then
If c = """" Then
inString = False
End If
Else
Select Case c
Case """"
inString = True
Case "("
parenthesis = parenthesis + 1
If parenthesis = 1 And Position = 1 Then
st = i + 1
End If
Case ")"
parenthesis = parenthesis - 1
If parenthesis = 0 And sp = 0 Then sp = i: Exit For
Case ","
If parenthesis = 1 Then
comma = comma + 1
If Position = 1 And comma = 1 Then sp = i: Exit For
If Position > 1 And comma = Position - 1 Then st = i + 1
If Position > 1 And comma = Position Then sp = i: Exit For
End If
Case Else
End Select
End If
Next i
If st = 0 Or sp = 0 Then
ExtractFormulaParameter = CVErr(xlErrNA)
Else
ExtractFormulaParameter = Mid$(formula, st, sp - st)
End If
End Function
By default it returns the first parameter, but you can also return the second or the third, and it should work with any formula.
Thanks for the replies all. I thought about this more, and ended up coming up with a similar solution to those posted above - essentially string manipulation to extract the text where we expect to find the logical test.
Works well enough, and I'm sure I could use it to extract further logical tests from substrings too.
I am attempting to build a vba code to build txt files that we use to test with. I am running into an issue. Some of my results will have .00 which I made dropped off using Str = Str & "00" & Left(CashRightJust(Range("h63"), 11), 9)
This basically is telling it to look at cell H63, right justified the amount but left justify the end by 9 to drop cents if it is "00".
My problem is we now need to test for it to have actual change like .25. Using this code alone adds a zero at the end of the change. I need to adjust this code to reflect if it is more then .00 do not edit or add zeros
I hope this makes sense. I am still fairly new at this and have gotten pretty far but there are still some moments I am lost. Thank you.
Spreadsheet created to build code to send to txt file
Function Detail_Rec1()
Dim strlencount As Integer
Dim strspacer As Integer
If Range("b63").Value <> "5" Then
Exit Function
End If
Str = Str & Range("b63").Value **Result: 5**
Str = Str & Range("c63").Value **Result: 400**
Str = Str & Range("d63").Value **Result: 1234567**
Str = Module1.SpaceAdd(Str, 1) **Result: 1 space**
Str = Str & Trim(Range("e63").Value)
strlencount = Len(Trim(Range("e63").Value))
strspacer = 30 - strlencount
Str = Module1.SpaceAdd(Str, strspacer) **Result: Company name with spacefill for 30 character; name is left justified**
Str = Str & Trim(Range("f63").Value)
strlencount = Len(Trim(Range("f63").Value))
strspacer = 11 - strlencount
Str = Module1.SpaceAdd(Str, strspacer) **Result: Company ID number; left justify; space filled total 11 characters**
Str = Str & Range("G63").Value Result: 116
Str = Str & CashRightJust(Range("h63"), 11) **Result: 1000; only 1000 no cents; dollars only; 11 character zero filled right justify**
Str = Str & CashRightJust(Range("i63"), 11)**Result: 1000; only 1000 no cents; dollars only; 11 character zero filled right justify**
Str = Str & CashRightJust(Range("j63"), 11)**Result: 1000; only 1000 no cents; dollars only; 11 character zero filled right justify**
Str = Str & Trim(Range("k63").Value)
strlencount = Len(Trim(Range("k63").Value))
strspacer = 4 - strlencount
Str = Module1.ZeroAdd(Str, strspacer) **Result: Rate of 4 characters entered; 4 character length**
Str = Module1.SpaceAdd(Str, 1) **Result: 1 space**
Str = Str & CashRightJust(Range("l63"), 11) **Result: 3348.75 needs to be 334875. 11 characters, right justified, no decimal.**
Str = Str & CashRightJust(Range("m63"), 11)
Str = Str & CashRightJust(Range("n63"), 11)
Str = Str & CashRightJust(Range("o63"), 11)
Str = Str & "00000" & Right(Range("p63").Value, 6)
strlencount = Len(Trim(Range("p63").Value))
strspacer = 6 - strlencount
Str = Module1.ZeroAdd(Str, strspacer)
[Excel image of line being coded][How text file should appear][2]2]
My end result for what I need is
23.45 - 2345
23.00 - 2300 unless the spec is saying dollars only then it needs to be 23
No rounding.
I hope this helps out more with the visuals
Added Info: My module that is used for the $ amts currently is following:
If Str = 0 Then
CashRightJust = ZeroAdd(Str2, c)
Exit Function
Else
If InStr(Str, ".") > 0 Then
Str2 = Right(Str, 2)
If InStr(Str2, ".") > 0 Then
strnew = Str & "0"
Else
strnew = Str
End If
Else
strnew = Str & "00"
End If
Excel snapshot of info being coded
54001234567 Bob's Tires 987654321 116000000010000000000005000000009503525 00000334875
This is how it is coming out:
54001234567 Bob's Tires 987654321 1160000010000000000005000000000950003525 000334875
I could not post the image of the txt file I don't have enough reputations; sorry; this is how it should appear
Can you try something like this? It assumes your entire string is in cell A1 and that this is the situation where dollars and cents are not required (I assume you can handle the situation where they are because it sounds like you more or less leave the string alone in that case).
lenOfStr = 11
newStr = ""
subStr = Right(Cells(1, 1), lenOfStr)
If Right(subStr, 2) = "00" Then 'we need to keep these
lenOfStr = 9
End If
foundLeftmost = False
For i = 1 To lenOfStr
If Mid(subStr, i, 1) <> "0" and Mid(subStr, i, 1) <> "." Then
newStr = newStr & Mid(subStr, i, 1) 'start collecting for the new string
foundLeftmost = True
End If
If foundLeftmost and Mid(subStr, i, 1) <> "." Then 'need to include zeros that may show up in the middle of the substring
newStr = newStr & Mid(subStr, i, 1)
End If
Next i
subStr = newStr
The end result is stored in subStr. Hopefully I understood your problem correctly. Let me know if I didn't.
How can I shorten this code? I want to make this code with If shorter in loop. I tried do something like this Me.Controls("x" & t) = 0 , but it's returning a syntax error. I don't know what I can do. Please help.
x = CStr(Int(Rnd() * 16))
Dim x1 As Byte = 0
...
Dim x30 As Byte = 0
For t = 0 To 15
If x = t And x1 = 0 Then
...
End If
If x = t And x2 = 0 Then
...
End If
...
If x = t And x30 = 0 Then
...
End If
Array are the best solution. First decide whether its one or two dimensional and then you can use it. I beleive yours is a two dimensional array.
You can set X1 to X30 in array and fetch the values. A mock code for both one and two dimensional array is here
1-D Array:
Dim Films(1 To 5) As String
Films(1) = "Lord of the Rings"
Films(2) = "Speed"
Films(3) = "Star Wars"
Films(4) = "The Godfather"
Films(5) = "Pulp Fiction"
MsgBox Films(4)
2-D Array
Dim Films(1 To 5, 1 To 2) As String
Dim i As Integer, j As Integer
For i = 1 To 5
For j = 1 To 2
Films(i, j) = Cells(i, j).Value
Next j
Next i
MsgBox Films(4, 2)
Please mark it as answer if this help(can help someone too).
Regards,
Mani