I have the following problem in Excel while calculating through a loop:
I need a variable (Destination Variable) that sequentially stores the results produced after each loop has been completed (avoiding the use of circular references) that would look like this:
'Let's call it "origin" variable in the worksheet
Origin Variable (50 x 50 array)
1 2 4
2 3 4
2 2 3
'Let's call it "destination" variable in the worksheet
Destination Variable (50 x 50 array)
1 1 1
1 1 1
1 1 1
After each loop, I'd need the macro to perform the following code:
range("destination").value = range("destination").value + range("origin").value
So that the destination variable would look like this after the current loop:
Destination Variable
2 3 5
3 4 5
3 3 4
However, Excel does not allow me to perform the previous function.
Does anyone have an answer how this could be solved?
Quite easy. I did this by recording as macro and tidying.
Sub Macro1()
Range("origin").Copy
Range("destination").PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End Sub
I like #S Meaden's answer, it is simple and I had not thought of that. And it certainly works for this purpose.
You could also do simple iteration. IN the example below I add two different ranges and put them in a third range, but this could be re-worked for your needs pretty easily, or it is another option if you ever need to add ranges to another range:
Sub AddArrays()
Dim rng1 As Range
Dim rng2 As Range
Dim rngSum As Range
Dim arr1 As Variant
Dim arr2 As Variant
Dim arrSum As Variant
Set rng1 = Range("A1:C7") '## Modify as needed
Set rng2 = Range("F1:H7") '## Modify as needed
Set rngSum = Range("K1:M7") '## Modify as needed
'Raises an error, Type Mismatch
'rngSum.Value = rng1.Value + rng2.Value
arr1 = rng1.Value
arr2 = rng2.Value
arrSum = rngSum.Value
Dim x As Integer, y As Integer
For x = LBound(arr1, 1) To UBound(arr1, 1)
For y = LBound(arr1, 2) To UBound(arr1, 2)
arrSum(x, y) = arr1(x, y) + arr2(x, y)
Next
Next
'Print result to sheet
rngSum.Value = arrSum
End Sub
Related
I have a very basic question, but would love to know how to do this. I want to write a function in VBA where I can highlight a column as an input, and then spit out the result somewhere else.
Thanks in advance :)
e.g. column A
--------
10
8
5
6
1
3
2
becomes:
column A
--------
10
8
6
2
I just did it from column a to b, but you probably want range as the current selection and a different output column.
Option Explicit
Sub filterlist()
Dim rng As Range
Set rng = Range("a1:a5")
Dim celluse As Range
Dim arr As Variant
For Each celluse In rng
If celluse.Value Mod 2 = 0 Then
If IsEmpty(arr) Then
arr = Array(celluse.Value)
Else
ReDim Preserve arr(UBound(arr) + 1)
arr(UBound(arr)) = celluse.Value
End If
End If
Next celluse
Dim i As Long
For i = 0 To UBound(arr)
Range("b" & i + 1) = arr(i)
Next i
End Sub
This code should do the trick.
You can enter as an array-formula directly to a sheet: {=RemoveOdds(A1:A7)} or as part of another procedure:
Sub Test()
RemoveOdds Selection
End Sub
Public Function RemoveOdds(Target As Range) As Variant
Dim vFinal() As Variant
Dim rCell As Range
Dim x As Long
ReDim vFinal(1 To Target.Cells.Count)
x = 1
For Each rCell In Target
If rCell Mod 2 = 0 Then
vFinal(x) = rCell.Value
x = x + 1
End If
Next rCell
'So missing values do not show up as 0 at bottom of array.
' Do While x <= Target.Cells.Count
' vFinal(x) = ""
' x = x + 1
' Loop
ReDim Preserve vFinal(1 To x - 1)
'RemoveOdds = vFinal 'Basic array - will place values horizontally on sheet.
RemoveOdds = Application.Transpose(vFinal) 'Will place values vertically on sheet.
End Function
I am working in VBA for Excel, and I have an array of integers. What I am trying to do is add 1 to a specific element inside the array when my conditions have been met. In my example code if the cell in column A is a 5 then I would like to add 1 in the 5th position of the array or if the cell is a 3 then add 1 to the 3rd position of the array.
Sub CountCustomers()
Dim myArray(5)
Dim i as integer
For i = 1 to 10
If Cells(i,1) = 5 Then
myArray(4) = myArray(4)+1
ElseIf Cells(i,1) = 3 Then
myArray(2) = myArray(2)+1
End If
Next
End Sub
When I run it like this it ends up with a 1 in the correct position but will not increase the values any higher. Is there a way to do this?
A couple of options below.
Better to work with arrays for speed than loops (option 2)
For this particular example you can use CountIF directly (option 1)
If you have multiple processing routes then Select can be more efficient than Else If
code #1
Sub Option1()
Debug.Print "number of 5's: " & Application.WorksheetFunction.CountIf([a1:a10], 5)
Debug.Print "number of 3's: "; Application.WorksheetFunction.CountIf([a1:a10], 3)
End Sub
code #2
Sub Option2()
Dim x
Dim myArray(1 To 5)
Dim lngCnt As Long
'put range into 2D variant array
x = [a1:a10].Value2
For lngCnt = 1 To UBound(x)
Select Case x(lngCnt, 1)
Case 5
myArray(4) = myArray(4) + 1
Case 3
myArray(2) = myArray(2) + 1
Case Else
'do nothing
End Select
Next
Debug.Print myArray(4), myArray(2)
End Sub
Your code works as expected. You should watch:Excel VBA Introduction Part 3 - What to do When Things Go Wrong (Errors and Debugging)
Here I set up watches to monitor your variables. The watches for myArray(2) and myArray(4) are set to break when there value changes.
I'm trying to compare two 2d arrays in VBA Excel.
Source:
1 2 3 4
4 5 6 2
3 3 4 4
Target:
4 5 3 2
1 2 3 4
3 7 7 5
Given the above two 2-d arrays which I will call source and target I want to compare each row from source with entire target and check if it exists in target. For
Example row 1 from source (1 2 3 4) would be considered a match as it would found in target (at row 2). So I need to compare each row in target for a given row from source. If row in source does not exist in target then I will need to make note of this some how in order to mark as not existing in target.
Something on the lines of (not actual code just idea):
For i to ubound(srcArray)
isFound = False
For j To ubound(trgArray)
If srcArray(i) = trgArray(j) Then
isFound = True
If Not isFound Then
//make note of some sort
I know approach worked ok for single dim. array. But trying to do this for 2d arrays in some sort of loop in VB or other method. Not too familiar with VB in Excel. I would also like to look at each row as entire array if possible rather than comparing each element for each array individually.
Here is an example of how to loop and compare the elements of a 2D array:
Sub ArrayCompare()
Dim MyArr1 As Variant, MyArr2 As Variant, X as long, Y as long
MyArr1 = [{1,2,3,4;4,5,6,2;3,3,4,4}]: MyArr2 = [{4,5,3,2;1,2,3,4;3,7,7,5}]
For X = LBound(MyArr1) To UBound(MyArr1)
For Y = LBound(MyArr1, 1) To UBound(MyArr1, 1)
If MyArr1(X, Y) = MyArr2(X, Y) Then MsgBox X & ":" & Y & ":" & MyArr1(X, Y)
Next
Next
End Sub
Here is my updated code to compare each row as a string (Thanks #Tim Williams :)):
Sub ArrayCompare()
Dim MyArr1 As Variant, MyArr2 As Variant, X As Long, Y As Long
MyArr1 = [{1,2,3,4;4,5,6,2;3,3,4,4}]: MyArr2 = [{4,5,3,2;1,2,3,4;3,7,7,5}]
For X = LBound(MyArr1) To UBound(MyArr1)
For Y = LBound(MyArr2) To UBound(MyArr2)
If Join(Application.Transpose(Application.Transpose(Application.Index(MyArr1, X, 0))), "|") = Join(Application.Transpose(Application.Transpose(Application.Index(MyArr2, Y, 0))), "|") Then MsgBox "Found a match at MyArr1 index:" & X & " and MyArr2 index:" & Y
Next
Next
End Sub
If you really want to avoid loops then you use this approach to extract a single "row" out of your 2-d array for comparison purposes, but it might be faster to loop.
Sub Tester()
Dim arr, rw
arr = Range("A1:J10").Value 'get 2-d array from worksheet
'get a 1-d array "row" out of the 2-d array
rw = Application.Transpose( _
Application.Transpose(Application.Index(arr, 1, 0)))
'then you can (eg) create a string for comparison purposes
Debug.Print Join(rw, Chr(0))
End Sub
I have Range(one dimensional), that I want to summarize in one cell by concatenating all values. I thought that I could do just:
Dim Data_array()
Dim Source_Range as Range
Set Source_Range = Selection
Data_array() = Source_Range.Value2
Source_range.Offset( -1 ,0).Value = Join(Data_array, ", ")
This however returns error 5 because Data_array is a ( 1 To X, 1 To 1) array it has two dimensions, and Join on last line requires that you provide just one dimenstional array.
So my question would be is there a way to remove that "1 To 1" dimension?
If not how would you concatenate a one dimensional range in one cell.
Example
A
1
2 2
3 4
4 6
Desired Result
A
1 2, 4, 6
2 2
3 4
4 6
You were so close! The code below assumes you will select the cells below the empty target cell. I't is simply two tweaks from your original code:
Sub testing()
Dim Data_array()
Dim Source_Range As Range
Set Source_Range = Selection
Data_array() = WorksheetFunction.Transpose(Source_Range.Value2)
Source_Range.Offset(-1, 0).Resize(1, 1).Value = Join(Data_array, ", ")
End Sub
Below is an idea. NOTE: I'm not sure that the OFFSET part of your code does what you want it to do. Test the code, and let me know if so.
Dim Data_array()
Dim Source_Range As Range
Dim nIncrement As Integer
Set Source_Range = Selection
nIncrement = 1
ReDim Data_array(1 To Source_Range.Rows.Count)
For Each cel In Source_Range
Data_array(nIncrement) = cel.Value
nIncrement = nIncrement + 1
Next cel
Source_Range.Offset(-1, 0).Value = Join(Data_array, ", ")
For your data, I would not bother with a VBA array. Consider:
Public Function Konkat(rin As Range) As String
For Each r In rin
v = r.Value
If v <> "" Then
Konkat = Konkat & "," & v
End If
Next r
Konkat = Right(Konkat, Len(Konkat) - 1)
End Function
This is because in your code, data_Array is actually a two-dimensional array.
You can use the INDEX worksheet function to slice out a column or row.
Sub JoinRangeComma()
Dim vaData As Variant
Dim rSource As Range
Dim wf As WorksheetFunction
Set wf = Application.WorksheetFunction
Set rSource = Selection
vaData = rSource.Value2
rSource.Cells(1).Offset(-1, 0).Value = Join(wf.Index(wf.Transpose(vaData), 1, 0), ", ")
End Sub
I am trying to program a simple loop to run through the user selected values and filter out some number display and the numbers I want in a different column.
I have 10 random numbers in a column in this order:
3
7
10
12
5
2
7
13
9
23
I essentially want to ignore the first value, retrieve the next two values, skip the fourth
value, retrieve the next two values and so on. So my output would be:
7
10
5
2
13
9
All I have is a loop that runs through the column. I think I would have to use the mod() function but I can't sem to get it right. All I have so far is this empty loop:
Sub findValues()
Do While Cells(x, 3).Value <> "" 'go through values in column 3 until empty cell is encountered
'skip first value
'retrieve next two values and put them in different column
'...
Loop
End Sub
Here's one solution to do it using a loop and Step 3.
It's not the fastest or optimized way, but it's one of many methods that works and this method is rather simplistic. The example assumes that the data is in column A and the new list will be output to column B.
Since you want to skip the first value, I start the loop at A2, then do a Step 3 each loop (but copy over 2 elements, so it'll always skip the 3rd element).
Sub test()
Application.ScreenUpdating = False
Dim i As Long, j As Long
Dim lastRow As Long
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
j = 1
For i = 2 To lastRow Step 3
Cells(j, 2).Value = Cells(i, 1).Value
Cells(j + 1, 2).Value = Cells(i + 1, 1).Value
j = j + 2
Next
Application.ScreenUpdating = True
End Sub
Note that using Cells(row, column) is better for looping than Range() notation (and faster, too).
[Update: formula solution]
enter this in D1 and copy down 2/3 the length of your C column
=IF(MOD(ROW(),2)=1,OFFSET($C$1,INT(ROW()/2)*3+1,0),OFFSET($C$1,INT(ROW()/2)*3-1,0))
[initial post]
I've used a variant array as its more efficient (albeit slightly more complex) than a loop
In short what you were looking for is a Mod function where
(Row-1) Mod 3 = 0
should be excluded
ie exclude position 1,4,7 etc
This code dumps the output from column C to D. It will cater for as many values that exist in C (note I have set the c range by looking up from bottom not down from top, so blanks wont through the code out)
Sub GetValues()
Dim rng1 As Range
Dim lngCnt As Long
Dim lngCnt2 As Long
Dim X
Dim Y
Set rng1 = Range([c1], Cells(Rows.Count, "C").End(xlUp))
X = rng1
ReDim Y(1 To 2 / 3 * rng1.Cells.Count, 1 To 1)
For lngCnt = 1 To UBound(X, 1)
If (lngCnt - 1) Mod 3 <> 0 Then
lngCnt2 = lngCnt2 + 1
Y(lngCnt2, 1) = X(lngCnt, 1)
End If
Next
[d1].Resize(UBound(Y, 1), 1) = Y
End Sub]