Subtracting Variants - excel

I am having trouble getting Variants to subtract. I am pulling data from a spreadsheet and if one cell states a phrase then I need the code to subtract one cell from another. If the cell does not state a phrase then I need it to copy one cell to another. I can get the code to run but nothing happens.
Private Sub CommandButton1_Click()
Dim x As Variant, y As Variant, z As Variant, a As Integer, B As String
'getting values for data
x = Range("D2:D48").Value
y = Range("I2:I48").Value
z = Range("E2:E48").Value
B = "Total ISU Days: "
'The the cells are empty then subtract. This is not what I wanted to do but I can't think of extracting strings from variants.
If IsEmpty(Range("D2:D48").Value) = True Then
a = y - z
End If
Range("N2:N48").Value = a
Range("M2:M48").Value = B
End Sub

x = Range("D2:D48").Value
y = Range("I2:I48").Value
z = Range("E2:E48").Value
A Variant contains metadata about its subtype. In this case, x, y, and z are all arrays of variants.
a = y - z
The right-hand side of this expression simply cannot be evaluated, because {array1} - {array2} means nothing: operators (arithmetic or logical) work off values, not array of values.
What is a supposed to be? It's declared As Integer, so its value is capped at 32,767 (should probably be a Long). If you mean to add up all the values in y and subtract that total from the sum of all values in z, then you need to be more explicit about how you do that - you could use Application[.WorksheetFunction].Sum to add things up:
sumOfY = Application.Sum(Range("I2:I48"))
sumOfZ = Application.Sum(Range("E2:E48"))
a = sumOfY - sumOfZ
And then...
Range("N2:N48").Value = a
That will put the value of a in every single cell in the N2:N48 range - is that really what you mean to do?
Or maybe you meant to do this instead?
Range("N2:N48").Formula = "=IF(D2="""",I2-E2,0)"
That would make each cell in N2:N48 calculate the difference between I and E for each row where D is empty... and there's not really any need for any VBA code to do this.

Let's simplify a bit the task and say that the idea is to substract the values in Range("C1:C6") from the corresponding values in the left - Range("B1:B6"). Then write the corresponding results in column E:
Of course, this would be done only in case that all values in column A are empty. This is one way to do it:
Sub TestMe()
Dim checkNotEmpty As Boolean: checkNotEmpty = False
Dim substractFrom As Range: Set substractFrom = Worksheets(1).Range("B1:B6")
Dim substractTo As Range: Set substractTo = Worksheets(1).Range("C1:C6")
Dim MyCell As Range
Dim result() As Variant
ReDim result(substractFrom.Cells.Count - 1)
Dim areCellsEmpty As Boolean
For Each MyCell In substractFrom
If Len(MyCell) > 0 Then checkNotEmpty = True
Next
Dim i As Long
For i = LBound(result) + 1 To UBound(result) + 1
result(i - 1) = substractFrom.Cells(i) - substractTo.Cells(i)
Next
Worksheets(1).Range("E1").Resize(UBound(result) + 1) = Application.Transpose(result)
End Sub
The code could be improved further, saving all ranges to an Array, but it works quite ok so far.
The part with the +1 and -1 in the For-loop is needed as a workaround:
For i = LBound(result) + 1 To UBound(result) + 1
result(i - 1) = substractFrom.Cells(i) - substractTo.Cells(i)
Next
because the arrays start from index 0, but the Cells in a range start with row 1.
Worksheets(1).Range("E1").Resize(UBound(result) + 1) = Application.Transpose(result) is needed, to write the values of the result array to the column E, without defining the length of the range in E.

Related

Finding multiple combinations of sums in Excel

Ive been trying to make something in Excel to find multiple combinations of sums.
I have list of numbers that needs to be added together to be either within ranges of 500-510 or 450-460.
Only two numbers from the list can be used to find the sum. the numbers can not be used more than once. and giving the combinations of multiple results would be great. and if a number is not used it is ok.
I've tried the solver add-in and some other tips I found from this site but could not find something that gives multiple answers.
Does anyone know if this will be possible?
I'd break this into 2 tasks. First would be to simply generate all of the index pairs to test in the input array. That's relatively simple with recursive procedure. This one uses a private Type to store the pairs, but it could adapted to use some other method of storing the pairs:
Private Type Tuple
ValueOne As Long
ValueTwo As Long
End Type
Private Sub FindCombinations(elements As Long, ByRef results() As Tuple, _
Optional ByVal iteration As Long = 0)
If iteration = 0 Then ReDim results(0)
Dim idx As Long
For idx = iteration To elements - 1
Dim combo As Tuple
With combo
.ValueOne = iteration
.ValueTwo = idx
End With
results(UBound(results)) = combo
If iteration <> elements And idx <> elements Then
ReDim Preserve results(UBound(results) + 1)
End If
Next
If iteration < elements Then FindCombinations elements, results, iteration + 1
End Sub
Then, you use a "entry-point" procedure to generate the index combinations, use those to index into your source array, and apply your selection criteria:
Private Sub FindMatchingSets(testSet() As Long)
Dim indices() As Tuple
FindCombinations UBound(testSet) + 1, indices
Dim idx As Long, results() As Tuple
For idx = LBound(indices) To UBound(indices)
Dim tupleSum As Long
tupleSum = testSet(indices(idx).ValueOne) + testSet(indices(idx).ValueTwo)
If indices(idx).ValueOne <> indices(idx).ValueTwo And _
((tupleSum >= 500 And tupleSum <= 510) Or _
(tupleSum >= 450 And tupleSum <= 460)) Then
Debug.Print testSet(indices(idx).ValueOne) & " + " & _
testSet(indices(idx).ValueTwo) & " = " & tupleSum
End If
Next
End Sub
It isn't clear what you intend to do with the results, so this simply outputs the calculated values to the Immediate Window. Example calling code:
Private Sub Example()
Dim test(4) As Long
test(0) = 100
test(1) = 200
test(2) = 250
test(3) = 260
test(4) = 400
FindMatchingSets test
End Sub
May modify it according to your need & try
Sub test()
Dim X, Y, TRw, GotNum, First, Second As Long
TRw = 1
With ThisWorkbook.ActiveSheet
For X = 1 To 100 ' assumed col A1 to A100 is the list
GotNum = .Cells(X, 1).Value
If (GotNum >= 450 And GotNum <= 460) Or (GotNum >= 500 And GotNum <= 510) Then
.Cells(X, 1).Font.Color = RGB(255, 0, 0)
First = GotNum
For Y = X + 1 To 100
GotNum = .Cells(Y, 1).Value
If (GotNum >= 450 And GotNum <= 460) Or (GotNum >= 500 And GotNum <= 510) Then
Second = GotNum
TRw = TRw + 1
.Cells(TRw, 3).Value = First ' write 1st Number in Col C
.Cells(TRw, 4).Value = Second ' write 2nd Number in Col D
.Cells(TRw, 5).Value = First + Second ' write Sum of 1st & 2nd in Col C
End If
Next Y
End If
Next X
End With
End Sub
I think your question needs to be a little clearer in terms of what your expected output is (do you want a list of combos, or just to see the results?), but here's my solution.
I've put a list of 20 numbers in column Y, and assigned them all a letter (a through to t) in column X
Then I've built a matrix of the combinations of a to t, and have entered the following formula (the below is for cell C3, but it can be copied and pasted into all parts of the matrix)
=IF(C$2=$B3,"x",VLOOKUP(C$2,$X:$Y,2,FALSE)+VLOOKUP($B3,$X:$Y,2,FALSE))
I've then used conditional formatting to set the colour of the cells if they meet your criteria for the sum - you can do this by highlighting all the sums (cell C3:V22) and going to
home / conditional formatting / new rule...
picking the rule type format only cells that contain
and then in the drop down menus picking Cell Value / Between / Your high range
and then selecting a format (fill background colour, usually)
Do this once for the "high" sum, and once for the "low" sum. You can make the colours the same or different, depending on what you want to see.
I've also for reference included a reference to what the number is in Row 1 and column A. The formula for row 1 is (example is for C1, but it can be copied across)
=VLOOKUP(C2,$X:$Y,2,FALSE)
And the formula for column A is (example for A3) =VLOOKUP(B3,$X:$Y,2,FALSE)
The advantage of this approach is that it's all in excel (no code required), but the disadvantage is that it's hard to get a list of results. You could use a different formula to just return the sum (e.g. return the text "205+298") when it meets one of the conditions, but then it's still a pain to get it out of the matrix format and into a single list. Much easier using VBA

Why array Index starts at 1 when passing range values to array

In this VBA program all I am trying to do is to pass an array from spreadsheet and add 1 to each of the array's cells. My problem is with the index of the array. when I start looping the array it doesnt
work when I start the index from zero ( I get error subscript out of range) but it works perfectly when I start the array from 1. Why is that? (I thought that would be the case only I specify at the top Option Base 1)
Sub Passarray()
Dim Array As Variant
Dim i, j As Integer
'Pass array and manipulate
Vol = Range("Volatility")
For i = 0 To 2
For j = 0 To 2
Vol(i, j) = 1+ Vol(i,j)
Next j
Next i
End Sub
That wasn't the case when you pass Range to arrays based on my experience.
I don't know the specific reason behind, but this link indicates that you cannot change this behavior.
QUOTE: The array into which the worksheet data is loaded always has an lower bound (LBound) equal to 1, regardless of what Option Base directive you may have in your module. You cannot change this behavior.
What you can do is to utilize the use of LBound/UBound like this:
Vol = Range("Volatility")
For i = LBound(Vol, 1) To UBound(Vol, 1)
For j = Lbound(Vol, 2) To Ubound(Vol, 2)
'~~> do stuff here
Vol(i, j) = 1 + Vol(i, j)
Next j
Next i
If however your Range is just one column with several rows, you pass it to Array like this:
Vol = Application.Transpose(Range("Volatility"))
For i = LBound(Vol) To UBound(Vol)
'~~> do stuff here
Vol(i) = 1 + Vol(i)
Next
This way, you will produce one-D array instead of two-D array.
To iterate values you can use above or you can also use For Each:
Dim x As Variant '~~> dimension another variant variable
For Each x In Vol
'~~> do stuff here
x = 1 + x
Next

Error with variant variable in regression output

I have a macro which is written to perform an OLS regression on data that is selected by the user. This is part of a larger add in that I am writing but I am stuck on what I think must be somewhat of a simple issue. I keep getting a subscript out of range error and I think its because I am getting a different sized matrix to what I am expecting.
The sub takes two variables as its arguments and calculated the OLS estimator given the specification. The y variable is always a n x 1 range (one column and multiple row) and the X variable is a n x m range (can be multiple columns and rows). When this function is used when X is a single column range, the For... Next block works for the following code:
For bcnt = 1 To k
Cells(bcnt, 1).Value = b(bcnt)
Next bcnt
But if the X variable is a multiple column range this won't work and it has to be the following:
For bcnt = 1 To k
Cells(bcnt, 1).Value = b(bcnt,1)
Next bcnt
I can't understand why as by my understanding b should always be a one dimensional array.
Would appreciate any help.
The actual sub:
Sub OLSregress(y As Variant, X As Variant)
Dim Xtrans, XtransX, XtransXinv, Xtransy As Variant
Dim outputsheet As Worksheet
Dim b As Variant
' The equation for this estimator is b=[X'X]^(-1)X'Y
Xtrans = Application.WorksheetFunction.Transpose(X)
XtransX = Application.WorksheetFunction.MMult(Xtrans, X)
XtransXinv = Application.WorksheetFunction.MInverse(XtransX)
Xtransy = Application.WorksheetFunction.MMult(Xtrans, y)
b = Application.WorksheetFunction.MMult(XtransXinv, Xtransy)
k = Application.WorksheetFunction.Count(b)
Set ouputsheet = Sheets.Add(, ActiveSheet)
ActiveSheet.Name = "Regression Output"
For bcnt = 1 To k
Cells(bcnt, 1).Value = b(bcnt, 1)
Next bcnt
End Sub
When you are referring to a range or are bringing in data from a sheet the array is always a 2 dimensional array. The first dimension is rows and the second is the columns.
This is a common point of confusion in VBA for excel because it's done without your intervention.
Your code is correct.
For more in-depth information check out this post

Split and sort strings components using Excel

I have a column in Excel with the format:
A01G45B45D12
I need a way to format it like this, that is divide the string into groups of three characters, sort the groups alphabetically and then join them together with a + sign between:
A01+B45+D12+G45
I wonder it this is possible using the built in formulas in Excel or if I have to do this using VBA or something else, I already have the code for this in C# if there is an easy way to use that from Excel. I have not written plugins for Excel before.
Edit to add:
The above is just an example, the string can be of "any length" but its always divisible by three and the order is random so I cannot assume anything about the order beforehand.
Sub ArraySort()
Dim strStarter As String
Dim strFinish As String
Dim intHowMany As Integer
Dim intStartSlice As Integer
strStarter = ActiveCell.Offset(0, -1).Value 'Pulls value from cell to the left
intHowMany = Int(Len(strStarter) / 3)
ReDim arrSlices(1 To intHowMany) As String
intStartSlice = 1
For x = 1 To intHowMany
arrSlices(x) = Mid(strStarter, intStartSlice, 3)
intStartSlice = intStartSlice + 3
Next x
Call BubbleSort(arrSlices)
For x = 1 To intHowMany
strFinish = strFinish + arrSlices(x) & "+"
Next x
strFinish = Left(strFinish, Len(strFinish) - 1)
ActiveCell.Value = strFinish 'Puts result into activecell
End Sub
Sub BubbleSort(list() As String)
'Taken from power programming with VBA
'It’s a sorting procedure for 1-dimensional arrays named List
'The procedure takes each array element, if it is greater than the next element, the two elements swap positions.
'The evaluation is repeated for every pair of items (that is n-1 times)
Dim First As Integer, Last As Long
Dim i As Long, j As Long
Dim temp As String
First = LBound(list)
Last = UBound(list)
For i = First To Last - 1
For j = i + 1 To Last
If list(i) > list(j) Then
temp = list(j)
list(j) = list(i)
list(i) = temp
End If
Next j
Next i
End Sub

Excel Geomean returns #value! sometimes?

I've modified the vba function below to suit my needs.
I have many workbooks with sheets that contain 4500+ rows, and I use the function to search for two given values (as boundaries). Then, it selects the rows as the range. Finally, do whatever on that range. The function:
Function GeoM(A, B)
Application.Volatile
Dim x As Integer
Dim y As Integer
Dim rng As Range
x = Application.WorksheetFunction.Match(A, Range("B:B"), 0) ' looking in col B
y = Application.WorksheetFunction.Match(B, Range("B:B"), 0) ' looking in col B
Set rng = Range(Cells(x, 18), Cells(y, 18)) 'Im working on col 18
GeoM = Application.WorksheetFunction.GeoMean(rng)
End Function
The problem is, this code works just fine except with GeoMeann. I noticed when the range of data is relatively small (number of data cells) it returns a value. However, if the range is larger than approx. 126 cells, it returns #value!.
I'm stuck and working on solving this issue. Is the GeoMean function limited to a given number of data?
Thanks
There appears to be a 170 character limit on my testing for earlier Excel versions (I tested in xl03), validated in this Mr Excel thread
(Xl10 worked fine on the longer dataset)
I also tried:
Using Evaluate
Using a 1D array
failed samples
Dim X
Set rng1 = Range("A1:A171")
MsgBox Evaluate("GeoMean(A1:A171)")
X = Application.Transpose(rng1)
MsgBox Application.WorksheetFunction.GeoMean(X)
to no avail.
So I think your two workarounds are either:
Inserting a formula via VBA into Excel and using this result
As per the MrExcel thread use the derivation of GeoMean, ie =EXP(AVERAGE(LN(Range)))
Suggested Approach
MsgBox Evaluate("EXP(AVERAGE(LN(A1:A171)))")
Thanks to brettdj, I fixed the function and it works now:
Function GeoM(A, B)
Application.Volatile
Dim x As Integer
Dim y As Integer
Dim rng As Range
Dim LnValue As Double
Dim count As Integer
x = Application.WorksheetFunction.Match(A, Range("B:B"), 0) 'look in col. B
y = Application.WorksheetFunction.Match(B, Range("B:B"), 0) 'look in col. B
Set rng = Range(Cells(x, 18), Cells(y, 18)) 'set range of rows on col# 18
Do
LnValue = LnValue + Math.Log(Cells(x, 18)) 'calculates sum of ln(value)
x = x + 1
count = count + 1 'calculates the total number of values
Loop Until x > y 'stop when x (upper row#) is greater than y (lower row#)
GeoM = Math.Exp((1 / count) * LnValue) 'GeoMean formula
End Function
This function searches a specified column for two values as upper and lower limits (Note: that means you shouldn't have repeated values in that column. In another words, the column should have unique values). Then, it finds the GeoMean of the values on other column, which has values fall in the same range of rows.

Resources