I am new to Vba and I have been trying to figure out how after an if statement to multiply two numbers in two different columns. the data in excel is laid out as below.What I am trying to do is to multiply the cost with the weight if the freighttype is for example store transfer but my code below does not work.Your help would be much appreciated.I do not know if I need two extra for loops for the cost and weight.
freighttype
Column(b)
Store Transfer
Ecommerce
Cost
Column(c)
7
6
Weight
column (e)
2
3
And the code is:
Option Explicit
Function essay(ft As Range) As Long
Dim x As Variant
For Each x In ft
If ft = "store transfer" Then
essay = Range("b2:b365").Offset(0, 1) * Range("b2:b365").Offset(0, 3)
Else
essay = 0
End If
Next x
End Function
Unlike Excel, you cannot multiply two arrays together in VBA.
For the equivalent, you can either loop through all the cells, multiplying them one by one and keeping a running total, or you can use the SUMPRODUCT worksheet function inside EVALUATE
Assuming, for example, that your ft range is in column B, starting with B2, you could use something like:
Option Explicit
Option Compare Text
Function essay(ft As Range) As Long
essay = Evaluate("=SUMPRODUCT((" & ft.Address & "=""store transfer"")*OFFSET(" & ft.Address & ",0,1)*OFFSET(" & ft.Address & ",0,3))")
End Function
for looping:
Function essay2(ft As Range) As Long
Dim c As Range
Dim L As Long
For Each c In ft
If c = "store transfer" Then _
L = L + c.Offset(0, 1) * c.Offset(0, 3)
Next c
essay2 = L
End Function
Note that the Option Compare Text statement makes the routine case insensitive.
Hi Guys I managed to solve the problem with your help ,please find the solution below.
Option Explicit
Function ecco(ft As Range) As Long
Dim x As Variant
Dim L As Long
For Each x In ft
If ft = "st" Then
L = x.Offset(0, 1) * x.Offset(0, 3)
Else
ecco = 0
End If
ecco = L
Next x
End Function
Related
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.
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
I following program to call values to array and compare the values and give a result. I asked this question in another thread.
VPA program for compare values in array and give a result (MS Excel)
Here we can see that one dimensional array to which values are assigned. But i want to call values from multiple column when a IF condition is true
Dim arr as variable
For i = 1 to u
if mycondition1 then
x = Cells(i, 2).Value
m = Application.WorksheetFunction.CountIf(Range("B4:B" & u), x)
ReDim arr(1 To m)
For j = 1 to u
if mycondition2 then
arr(y) = Cells(j, 27)
End If
Next j
For one dimensional array i use code arr(y) = Cells(j, 27). Here i want to call values from column 27. Like this i want to assign values from different column (Say 27, 28, 29 upto 32). Instead of create six arrays, I know i can use two dimensional array say arr(1 to m, 1 to 6) and get values assigned from cells of each column and rows. But don't know how to compare values for each column similar to codes given below (which is comparison for one column values). I forced to write one comparison codes for each column. So my coding lines are more and take lots of time to execute. And i want do the for loop upto u=100.000 rows. Is there any easy way
w = arr()
Res = Application.Match(Array("No", "-"), w, 0)
For Each r In Res
ThisWorkbook.Worksheets("Sheet1").Cells(i, 27) = "X"
If Not IsError(r) Then
ThisWorkbook.Worksheets("Sheet1").Cells(i, 27) = "O"
Exit For
End If
Next r
Erase arr()
Exitsinglepart:
End If
Next i
End Sub
Please help me how to rewrite this code for comparing values called from each column.
Firstly, I must say that I don't understand what you want. Secondly, I feel that you are going about it the wrong way. In view of my first observation, I apologise. This is the way I would go about it:-
Private Sub TestIsYes()
Dim Arr As Variant
Arr = Array("Yes", "-", "Yes", "yes", "Yes")
Debug.Print IsYes(Join(Arr, ","))
End Sub
Function IsYes(StrArr As String) As String
' 25 Mar 2017
Dim Fun As Boolean
Fun = CBool(InStr(1, StrArr, "no", vbTextCompare))
If Not Fun Then
Fun = CBool(InStr(StrArr, "-"))
End If
IsYes = Split("No Yes")(CInt(Fun) + 1)
End Function
As you see, the function IsYes receives a string like "Yes,-,yes,Yes" and returns "Yes" or "No" based upon your criteria. You can test the function by changing the elements of the parameter array in the sub TestIsYes. TestIsYes could write this result directly into any cell on the worksheet.
This function might be modified in whatever way you need, but it remains at the core of your project. The question therefore is how to produce the string passed to IsYes as an argument. You wish (or should wish, perhaps) produce this string from a range. The next function does that.
Private Function RangeToString(Rng As Range) As String
' 25 Mar 2017
Dim Fun As String
Dim Arr As Variant
Dim R As Long, C As Long ' rows / columns
Arr = Rng.Value
With Arr
For R = LBound(Arr) To UBound(Arr)
For C = LBound(Arr, 2) To UBound(Arr, 2)
Fun = Fun & Arr(R, C) & ","
Next C
Next R
End With
RangeToString = Fun
End Function
Note that any array produced from an Excel range is 3-dimensional, even if it was taken from a single column. Therefore the above function produces a string of the kind required by IsYes from any range, regardless of how many columns it has.
I have set up a test in the worksheet range B2:C5 (4 rows, 2 columns - expand or reduce this as you wish), filled with your criteria. I created the following function using the functions explained before.
Function UDFIsYes(Rng As Range) As String
' 25 Mar 2017
UDFIsYes = IsYes(RangeToString(Rng))
End Function
You can call this function from the worksheet entering =UDFIsYes(B2:C5). You can call the same function from a VBA procedure like the following.
Private Sub TestUDF()
Debug.Print UDFIsYes(ActiveSheet.Range(Cells(2, 2), Cells(5, 3)))
End Sub
I hope this helps. Let me know where this information falls short of what you need.
I sometimes work with symmetric matrices in MS-Excel (both v2007 and v2003).
Is there an option to help me to copy expressions from the lower triangle to the upper one?
It should be something like copy and paste/transponse but those functions normally work only with rectangular areas.
in the added picture you can see an exemple of an expression that I have to replicate by linking the symmetric value in the superior triangle of the matrix.
To get the number in the appropriate cell, we can use OFFSET and the cell address the forms the base of the table. Note that the formula will produce a *Circular Reference` error if entered in on the diagonal. The formula will work for both sides of the diagonal - you just have to decide which one will hold the data, and which will hold the formula.
Offset takes Row and Column to decide the target. By subtracting the base cell row and column from the current position, we can invert the row and columns, and get the data.
Using your example, with the origin of the table in B2, we end up with the following formula:
=OFFSET($B$2,COLUMN()-COLUMN($B$2),ROW()-ROW($B$2))
you can copy this formula into the cells, and get the reflection. Now you have the number, you can do any calculation you require on the reflection. Using your example, this would make the formula:
=10-OFFSET($B$2,COLUMN()-COLUMN($B$2),ROW()-ROW($B$2))
Result:
Using INDEX to make it non volatile would change the formula slightly. First, we would need a reference to the entire table, not just the top cell. Second, we would need to add 1 to the row/column calculation, as it refers to the first cell as row/column 1, not an offset of 0 as the previous formula.
=INDEX($B$2:$K$11,COLUMN()-COLUMN($B$2)+1,ROW()-ROW($B$2)+1)
and your example of 10-Cell would become:
=10-INDEX($B$2:$K$11,COLUMN()-COLUMN($B$2)+1,ROW()-ROW($B$2)+1)
As one of the above answers demonstrates, this can be done by using Excel formulas. I however find this to be a very tedious procedure. Especially if this is something you need to do on a regular basis. In that case VBA could save you a lot of time.
The following code will work on a square selection and fill the rest of the matrix no matter if it is the lower- or upper part of the matrix that is pre-filled.
Option Explicit
Sub FillSymetricMatrix()
Dim i As Integer, j As Integer
Dim SelRng As Range
Dim FillArea As String
Dim FRow As Integer
Dim FCol As Integer
Set SelRng = Selection
FRow = SelRng.Rows(1).Row
FCol = SelRng.Columns(1).Column
'Returns information about which area to fill
If ActiveSheet.Cells(FRow + SelRng.Rows.Count - 1, FCol).Value <> vbNullString Then 'Lower filled
If ActiveSheet.Cells(FRow, FCol + SelRng.Columns.Count - 1).Value = vbNullString Then 'Upper empty
FillArea = "Upper"
Else
FillArea = "Error"
End If
Else
If ActiveSheet.Cells(FRow, FCol + SelRng.Columns.Count - 1).Value <> vbNullString Then 'Upper filled
FillArea = "Lower"
Else
FillArea = "Error"
End If
End If
'Determines if the selection is square
If SelRng.Rows.Count <> SelRng.Columns.Count Then FillArea = "Error"
'Fills empty area of the square (symetric) matrix
Select Case FillArea
Case Is = "Upper"
For i = 0 To SelRng.Rows.Count - 1 Step 1
For j = 0 To SelRng.Columns.Count - 1 Step 1
If i <= j Then ActiveSheet.Cells(i + FRow, j + FCol).Value = ActiveSheet.Cells(j + FRow, i + FCol).Value
Next j
Next i
Case Is = "Lower"
For i = 0 To SelRng.Rows.Count - 1 Step 1
For j = 0 To SelRng.Columns.Count - 1 Step 1
If i <= j Then ActiveSheet.Cells(j + FRow, i + FCol).Value = ActiveSheet.Cells(i + FRow, j + FCol).Value
Next j
Next i
Case Else
MsgBox "The procedure cannot be performed on the current selection!"
End Select
End Sub
I guess what you need is a function which returns the "diagonal" value of a square matrix, e.g. for any X(j,k) return X(k,j)
Try this:
Function DIAGONAL(Arg As Range, Reference As Range) As Variant
Dim MyRow As Long, MyCol As Long
If Reference.Rows.Count <> Reference.Columns.Count Then
DIAGONAL = CVErr(xlErrRef)
Else
MyRow = Arg.Row - Reference.Row + 1
MyCol = Arg.Column - Reference.Column + 1
If MyRow < 1 Or MyCol < 1 Or MyRow > Reference.Rows.Count Or MyCol > Reference.Columns.Count Then
DIAGONAL = CVErr(xlErrNA)
Else
DIAGONAL = Reference(MyCol, MyRow)
End If
End If
End Function
once you entered this function in VBA, you can use it inside or outside your square matrix ... you just need to ensure that your argument (parameter: Arg) is within the matrix (parameter: Reference) ... or you get an #N/A error. Or you get a #REF error if the matrix isn't square.
So in your example you would enter into B4: =10-DIAGONAL(B4,$B$2:$K$11) and copy this throughout the lower triangle.
You can even transpose a complete matrix ... in your screen shot, move to cell B13, enter =DIAGONAL(B2,$B$2:$K$11) and copy 9x down & right
No buttons, no need to explicitely start a Sub ... any size of n x n matrix, handles strings and numbers, ...
Here is an example with VBA. Start with an un-filled table and a button.
Then make the button run the code:
Option Explicit
Private Sub symmButton_Click()
MakeSymmetric Range("B2")
End Sub
Public Sub MakeSymmetric(ByRef r As Range)
Dim M As Long
M = CountCols(r)
Dim vals() As Variant
vals = r.Resize(M, M).Value2
Dim i As Long, j As Long
For i = 2 To M
For j = 1 To i - 1
vals(i, j) = vals(j, i)
Next j
Next i
r.Resize(M, M).Value2 = vals
End Sub
Public Function CountCols(ByRef r As Range) As Long
If IsEmpty(r) Then
CountCols = 0
ElseIf IsEmpty(r.Offset(0, 1)) Then
CountCols = 1
Else
CountCols = r.Worksheet.Range(r, r.End(xlToRight)).Columns.Count
End If
End Function
and finally observe the results
Similar to Sean's solution, I would also use formulas. In order to get the transposed value, use this formula:
=INDEX($B$2:$G$7,COLUMN()-COLUMN($B$2)+1,ROW()-ROW($B$2)+1)
If you want to do a more complex operation (e.g. =10-[transposedValue]), I'd recommend you use a named range: Insert a new name, e.g. TransposedValuein the Name Manager. Instead of a cell link, provide the above formula. Now you can literally write the following formula in your matrix:
=10-TransposedValue
I have this way. As you said copy paste transpose work on rectangular range. And your problem is that you have a triangular range.
You will love this....
1). Select the square range containing your upper triangular matrix and Copy.
2). Select a cell in an empty place and do the following two steps
a.) Paste Special - Values
b.) Paste Special - Values - Transpose - Skip Blanks
And you have got your symmetric matrix :-)
Anil.
Mixing together Ja72's fill code with SeanC c's Excel function code, I think I can make a generic matrix template that is properly prefilled with the dynamic Excel formula. So dynamic, and can be reused without any copy and paste.
Public Sub MakeSymmetric(ByRef r As Range)
Dim M As Long
M = 300
' Was CountCols(r), but I just limited to 300 columns for now
Dim vals() As Variant
vals = r.Resize(M, M).Value2
Dim i As Long, j As Long
For i = 2 To M
For j = 1 To i - 1
vals(j, i) = "=OFFSET($B$2,COLUMN()-COLUMN($B$2),ROW()-ROW($B$2))"
Next j
'Make diagonal down the middle show ---
vals(j, i) = "---"
Next i
vals(1, 1) = "---"
r.Resize(M, M).Value2 = vals
End Sub
Sub FillSymmetric()
MakeSymmetric Range("B2")
End Sub
I don't really know any VB though, so I haven't quite figured out how to fill the header yet. I don't know Stackoverflow yet either, but I will try to add a picture.
Original List to Matrixize
Dynamically transposing values typed in SouthWest half to NorthEast half
Short answer: INDIRECT(ADDRESS(COLUMN(D2), ROW(D2)))
Explnation: you may remember we use coordinates with numbers to represent a location in Cartesian Coordinates System. So, it's easy to get a diagonal symmetric value e.g. just change (2, 3) to (3, 2).
But in Excel, we need a wordaround if we want to do so. Because, address is marked by a combination of a letter and a digit, say B2. You can't just change B2 to 2B.
Luckily, we can still use numbers to represent a cell by leveraging the power of COW() and COLUMN().
In the image below, C2 and B3 are symmetrical. This shows how to put the value of C2 to B3.
Making the formula from C.W. more generic (similar to Peter Albert), this will help when your matrix is not starting at A1 but e.g. in C10:
=INDIRECT(ADDRESS(COLUMN(C11)-COLUMN($C$10)+1,ROW(C11)-ROW($C$10)+1))
So, subtract the origin row/column and add 1.
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