Trim a specific string - vb.net

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("="))

Related

Sort multiple arrays using a sort by date function

I have three arrays, DueDateArr, MilestoneDollarsArr, MilestoneNameArr.
I wish to sort DueDateArr chronologically and using the same sorting procedure also sort the other arrays in the same order. I used How can I sort dates in an array in vba? with additional array sorting parts but this doesn't seem to work correctly. In the output everything is ok except for the first entry being the wrong date.
Alternatively if its possible I'd like to use something like a linked list that they have in java that is a sortable multiple dimensional array with different variable types.
Data is as follows:
Sorted data is as follows: (note first entry is incorrect)
Dim TotalCountMinusOneForArrays as Integer
Dim DueDateArr() As Date
Dim MilestoneDollarsArr() As Double
Dim MilestoneNameArr() As String
Dim DueDateValue As Date
Dim MilestoneNameValue As String
Dim DueDateInfo As Date
Dim MilestoneDollarsInfo As Double
Dim MilestoneNameInfo As String
Dim i As Long, j As Long
i = 0
j = 0
For j = 2 To TotalCountMinusOneForArrays
DueDateInfo = DueDateArr(j)
MilestoneDollarsInfo = MilestoneDollarsArr(j)
MilestoneNameInfo = MilestoneNameArr(j)
For i = j - 1 To 1 Step -1
If (DueDateArr(i) <= DueDateInfo) Then GoTo Sort
DueDateArr(i + 1) = DueDateArr(i)
MilestoneDollarsArr(i + 1) = MilestoneDollarsArr(i)
MilestoneNameArr(i + 1) = MilestoneNameArr(i)
Next i
i = 0
Sort: DueDateArr(i + 1) = DueDateInfo
MilestoneDollarsArr(i + 1) = MilestoneDollarsInfo
MilestoneNameArr(i + 1) = MilestoneNameInfo
Next j
The simple approach would be to programmatically sort your data first using built-in sort functionality and then populate the array. However, when that is not an option, the two popular solutions are Bubble Sort or Merge Sort
Bubble sort being the easiest to apply:
Do Until bSort = False
bSort = False
For i = 0 to UBound(ArrToSort) - 1
If ArrToSort(i + 1) < ArrToSort(i) Then
tempVal = ArrToSort(i)
ArrToSort(i) = ArrToSort(i + 1)
ArrToSort(i + 1) = tempVal
bSort = True
End If
Next i
Loop
For your case, if you wanted to do it multidimensionally instead of with several arrays you could do this
Do Until bSort = False
bSort = False
For i = 0 to UBound(ArrToSort) - 1
If CDate(ArrToSort(i + 1, 1)) < CDate(ArrToSort(i, 1)) Then
for i2 = 1 to 3
tempVal(1, i2) = ArrToSort(i, i2)
ArrToSort(i, i2) = ArrToSort(i + 1, i2)
ArrToSort(i + 1) = tempVal(1, i2)
next i2
bSort = True
End If
Next i
Loop
Where ArrToSort(i, 1) is your date data in your multidimensional array.
EDIT:
Worth mentioning, to my knowledge there sadly is no fast way to sort arrays in excel VBA other than the methods provided.
EDIT 2:
Added CDate() around the date values of the array in the Bubble Sort.

Excel VBA XIRR not working as expected

I am working a code, and I have a problem with Excel's XIRR function.
You have a matrix with 2 columns (dates and amounts), so the inputs are the matrix, a date, and a quantity. Inside the code it takes the values below the date you used as input, makes a new array with those values, and add also the date and amount you entered as inputs. And the output should be the XIRR of that array. It doesn´t seem to work. It works with IRR, with dates are an important input. Does someone know how to fix this problem? Thanks in advance!
Function Retorno(matriz As Range, dia As Date, valuacion As Double) As Double
Dim Datos As Range
Dim Aux1()
Dim Aux2()
Dim i, j, m, n As Integer
Set Datos = matriz
j = 0
For i = 1 To Datos.Rows.Count
If Datos(i, 1) <= dia Then
j = j + 1
End If
Next i
ReDim Aux1(1 To j + 1)
ReDim Aux2(1 To j + 1)
For n = 1 To j + 1
Aux1(n) = Datos(n, 2)
Next n
Aux1(j + 1) = valuacion
For m = 1 To j + 1
Aux2(m) = Datos(m, 1)
Next m
Aux2(j + 1) = dia
Retorno = WorksheetFunction.Xirr(Aux1, Aux2)
End Function
Your last Aux2(j + 1) = dia is overwriting the second date in the array with the first date, giving you two identical dates in the date array.
Possibly you want to delete that line.
The other possible answer to this problem is to convert the date to numbers if you do this: Aux2(m) = Datos(m, 1)*1 XIRR will work too.

Label a set of objects with (A->Z,AA->ZZ, AAA->ZZZ) in VBA

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

Shortest Flow Layout Solver

I have a routing sequence for a set of machines on an assembly line. Each route has to go through the entire line (that is, if you only run the first and second machine, you still account for the distance from the second to the end of the line).
I have six different machines (720 possible combinations of machines) with fixed distances between each location on the line. The distance between the first and second machine is 100', the distance between second and third is 75', third and fourth is 75', fourth and fifth is 25', and fifth and sixth is 25'.
I have 4 different products that have to run down the line, and each of them have a fixed routing.
My problem is, how do I set up a vba code or solver that will allow me to run through all possible combinations of the line setup and determine the optimal setup for this line? Any machine can be placed at any location, as long as it optimizes the result!
The four product routes are :
A - B - C - D - F
A - C - B - D – E - F
A - F - E - D - C - B - A - F
A - C - E - B - D – F
Running through all possible combinations - if you really need to do that - is a job for something like Heap's algorithm, although I prefer the plain changes method:
Sub Evaluate(Lineup() As String)
' dummy evaluation, just output the permutation
Dim OffCell As Long
For OffCell = LBound(Lineup, 1) To UBound(Lineup, 1)
ActiveCell.Offset(0, OffCell).Value = Lineup(OffCell)
Next OffCell
ActiveCell.Offset(1, 0).Activate
End Sub
Sub AllPerms(Lineup() As String)
' Lineup is a 1-D array indexed at 1
Dim LSize As Long
Dim Shift() As Long
Dim Tot As Long
Dim Idx As Long
Dim Level As Long
Dim Change As Long
Dim Offset As Long
Dim TempStr As String
LSize = UBound(Lineup)
ReDim Shift(LSize)
'count of permutations, set initial changes
Tot = 1
For Idx = 2 To LSize
Tot = Tot * Idx
Shift(Idx) = 1 - Idx
Next Idx
Shift(1) = 2 ' end condition
' go through permutations
For Idx = 1 To Tot
' check this one
Call Evaluate(Lineup)
' switch for the next
Level = LSize
Offset = 0
Change = Abs(Shift(Level))
Do While Change = 0 Or Change = Level
If Change = 0 Then Shift(Level) = 1: Offset = Offset + 1
If Change = Level Then Shift(Level) = 1 - Level
Level = Level - 1
Change = Abs(Shift(Level))
Loop
Shift(Level) = Shift(Level) + 1
Change = Change + Offset
TempStr = Lineup(Change)
Lineup(Change) = Lineup(Change + 1)
Lineup(Change + 1) = TempStr
Next Idx
End Sub
Sub ABCDEF_case()
Dim LU(6) As String
LU(1) = "A"
LU(2) = "B"
LU(3) = "C"
LU(4) = "D"
LU(5) = "E"
LU(6) = "F"
Call AllPerms(LU)
End Sub

Comparing Basic Strings Exponential Complexity

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