I previously used the following code -
Dim HSArr(2 To 250) As Variant
Dim HSVal As Long
For HSVal = LBound(HSArr) To UBound(HSArr)
HSArr(HSVal) = Cells(HSVal, 1) & " " & Cells(HSVal, 2)
Next HSVal
It was an array that would concatenate column A and B, then the array would be output onto the worksheet in "P2:P250".
Sub SumData()
Const dFormula As String _
= "=IFERROR(SUMPRODUCT(--(P$2:P$250=I2),D$2:D$250,F$2:F$250),"""")"
With ThisWorkbook.Worksheets("Sheet1").Range("K2:K250")
.Formula = dFormula
.Value = .Value
End With
End Sub
This code does what I want to an extent but requires "P2:P250" to contain the array output, but I don't want to output anything onto the worksheet.
There's a piece of information that I do not understand here, how I can introduce those values from the array into the SUMPRODUCT (instead of "P2:P250"), even if its not by methods of array, as AFAIK I can't use that as a range without it being on the worksheet itself. Any idea?
Building an array with VBA then trying to use it with a formula in a worksheet without placing that information into a worksheet generally wouldn't work, however here you can use the source data in the formula instead:
=IFERROR(SUMPRODUCT(--(A$2:A$250&" "&B$2:B$250=I2),D$2:D$250,F$2:F$250),"""")
Related
I have a massive Excel template that's having performance issues. I'd like to optimize the VBA code I'm using to modify cells to be more of an "all at once" approach. I have several basic functions using loops to modify values. Here's an example:
Dim aCell as Range
For Each aCell In Range("A1:A9999").Cells
'appends prefix to value of each cell
aCell.Value = "CC_" & aCell.Value
Next aCell
While this works, the drawback of this is that it causes several recalculations and updates that slows down the template. I'm familiar with turning calculations/screen updating on and off, but for reasons I won't go into, that's not an option.
This code below does NOT work, but it's the approach I'm looking for. Is there a way to make such a change using an array or some other tool I'm not thinking of that would minimize the templates calculation updates?
Range("A1:A9999").Value = "CC_" & Range("A1:A9999").Value
Thank you!
Reading/writing to/from the worksheet takes a lot of time. Do the modifications within a VBA array, then write it back.
Dim myRange As Range, myArr As Variant
Set myRange = Range("A1:A9999")
myArr = myRange
For i = 1 To UBound(myArr, 1)
myArr(i, 1) = "CC_" & myArr(i, 1)
Next i
myRange = myArr
You could temporarily create a column full of functions, then paste those values over the column A values:
Range("XFD1:xfd9999").Formula = "=""CC_""&A1"
Calculate
Range("A1:a9999").Value = Range("XFD1:XFD8").Value
Range("XFD1:XFD9999").ClearContents
I'm operating on the assumption here that you are not using column XFD for anything else. If you are, you could use a different column for this purpose.
FWIW, you can do it without a loop using Evaluate like this:
Sub addText()
With Range("A1:A9999")
.Value2 = .Worksheet.Evaluate("INDEX(""CC_""&" & .Address & ",)")
End With
End Sub
I was revisiting this (trying to still make it faster) and now that I have a little better understanding, I would recommend an approach shown below. The accepted answer is hard-coded for one column, which was my example asked, but the below approach is more dynamic.
Sub sampleArraySheetEdit()
Dim aRange As Range: Set aRange = Range("A1:B9999") ' or whatever your range is...
Dim vRng() As Variant: vRng = aRange
Dim r As Long, c As Long
For r = LBound(vRng, 1) To UBound(vRng, 1) 'this ensures all cells always accounted for
For c = LBound(vRng, 2) To UBound(vRng, 2)
'perform you operation here....
vRng(r, c) = "CC_" & vRng(r, c)
Next c
Next r
aRange = vRng
End Sub
using the following code i have tried to generate an array based on what is in column "LN", (all values in "LN" are named ranges, corresponding to different cells). Then using vlookup I want it to look at cell d25, and look for a match within every named range of the array.
Sub Find_Value()
Sheets(“Sheet5”).Select
Dim arr() As Variant
arr() = Sheets("Sheet5").Range("LN4:LN" & LRow).Value
Dim I As Long
For I = 1 To Range("LN").End(xlUp).Value
Sheets(“Estimation - Entry”).Select
Range("P40").Value = arr(1)
Range(“E25").Value=WorksheetFunction.Vlookup(Range(“D25").Value,Range((arr(i)),2,0)
End Sub
(this code doesn't work and i am unsure why)
I am trying to avoid the use of loops for populating arrays since they take a lot of time when managing a lot of data.
Apparently as well, that is possible and easy in VBA but often results in problems.
Here is the code:
sub populate()
'put the whole column in an array
Dim AppArray() As Variant
Dim AppRange As Range
'calculate the last row of the column 1 of sheets
Dim LstRow As Integer
LstRow = Sheets("whole").Cells(Sheets("whole").Rows.Count, "A").End(xlUp).row
'here I calculate the range that I want to pass to the array
Set AppRange = Sheets("whole").Range(Cells(1, 1), Cells(LstRow, 1))
MsgBox ("apprange " & AppRange.Address)
'i dont know if I need to redim or not
ReDim AppArray(1 To LstRow)
'here comes the point. populate the array with the values of the range
AppArray = AppRange.Value
End Sub
This does not work. I also tried application.tranpose(AppRange.Value).
I used:
For i = 1 To LstRow
Debug.Print AppArray(i)
Next
and an error appears, so somehow there is no AppArray(1).
I would be very happy if you can comment on that. More than just arranging the code suggest even other pages (links) to populate arrays with values of ranges when these ranges are not known in advance.
If the case is that looping is very time consuming and that arrays can be populated straight away, I don't understand why 99% of the pages referring to arrays use a loop (or nested loop) to populate an array.
I found the answer.
dim myRange as range
dim myArray() as variant
myRange = range(cells(2,3),cells(10,15))
redeem myArray(1 to 20,1 to 20)
myArray=myRange
It's always much faster to work with variables and arrays than with cells values.
I am working through an Access 2010 VBA script. I am pulling information from a temporary table that may have 1 to 10 records in it. I am using GetRows to build a two-dimensional array that looks like this, for example:
**0** **1**
8677229 1
10289183 2
11981680 3
13043481 4
I have tested the array function by debug print, and the array does contain values. I want to split out the array values dynamically into variables for later use. In this example, I would like the 0 column to produce 4 variables named Anum(0) through Anum(3), and the 1 column to produce 4 variables named Pay(0) through Pay(3). However, I keep getting a "Error 9, subscript out of range" where indicated below:
Dim db As Database
Dim rs As Recordset
Dim PayAcct As Variant
Set db = CurrentDb
Set rs = db.OpenRecordset("SELECT Anum, Pay FROM PayPerAcct")
Dim highval As Integer
Dim i As Integer
i = 0
While Not rs.EOF
PayAcct = rs.GetRows(10)
Wend
highval = UBound(PayAcct, 2)
Dim Anum() As Variant
Dim Pay() As Variant
For i = 0 To highval
'error occurs on the below line
Anum(i) = CStr(PayAcct(0, i))
Pay(i) = CStr(PayAcct(1, i))
Next i
When I manually define Anum and Pay variables and use the Cstr(PayAcct(1,0)) operation, it passes the expected value from the array to the variable, so I don't think that is the problem.
I suspect I am assigning Anum() and Pay() the wrong dimension, because I have seen similar example code in Excel VBA where defining those variables as Range works. I have tried defining Anum() and Pay() as Range (which doesn't work, because this is Access VBA), Variant, and Object.
Any thoughts or tips?
Edit -
The below ended up working, thanks for your help:
Dim Anum() As String
ReDim Anum(0 To highval)
Dim Pay() As String
ReDim Pay(0 To highval)
Dim Anum() As Variant
declares a dynamic array that hasn't any elements yet, so you can't assign values to it. It needs a ReDim to use it.
But since you already know how many elements you need, what you want is:
Dim Anum(0 To highval) As Variant
or if you know that you will only store strings in it,
Dim Anum(0 To highval) As String
I have a spreadsheet of data that I want to put into a VBA array which then outputs unique values to a new sheet. I have got that to work so far. However, some of the cells in the original data have text separated by commas, and I want to add those to the array as well. I can't quite get that bit to work.
After the various 'dims', my code is
'Grabs the data to work with
Set rTable = Worksheets("Data Entry").Range("N1:N100", "P1:P100")
'Puts it into an array
MyArray = rTable.Value
'Sets where the data will end up
Set rCell = Worksheets("TestSheet").Range("A1:A100")
'Each unique entry gets added to the new array
On Error Resume Next
For Each a In MyArray
UnqArray.Add a, a
Next
'Add unique data to new location
For i = 1 To UnqArray.Count
rCell(i, 1) = UnqArray(i)
Next
I have tried doing a new variant to store the split data
SpArray = split(MyArray,", ")
and then have that here
MyArray = rTable.Value
SpArray = split(MyArray,", ")
and then refer to SpArray for the rest of the code
I've also tried to have as part of
For Each a in SpArray
but it doesn't work for me.
Do I need to do a separate loop on each cell of the array before I filter out the unique ones?
Yes, you need another loop. But if you set a reference to Microsoft Scripting Runtime and use a Dictionary object, you can eliminate the loop that writes to the range because Dictionary.Keys returns an array.
In this example, it attempts to split every entry on a comma and treats each of those as a unique. If there is no comma, Split returns the one value so it works in both cases. There's probably a small cost to splitting things that don't need to be split, but you won't notice until your range is much larger. And it makes the code cleaner, I think.
Sub WriteUniques()
Dim dcUnique As Scripting.Dictionary
Dim vaData As Variant
Dim vaSplit As Variant
Dim i As Long, j As Long
vaData = Sheet1.Range("$I$12:$I$62").Value
Set dcUnique = New Scripting.Dictionary
For i = LBound(vaData, 1) To UBound(vaData, 1)
vaSplit = Split(vaData(i, 1), ",")
For j = LBound(vaSplit) To UBound(vaSplit)
If Not dcUnique.Exists(vaSplit(j)) Then
dcUnique.Add vaSplit(j), vaSplit(j)
End If
Next j
Next i
Sheet1.Range("J12").Resize(dcUnique.Count, 1).Value = Application.Transpose(dcUnique.Keys)
End Sub
The code tweak that worked for me was to put the Split at the end.
'Add unique data to new location
For i = 1 To UnqArray.Count
rCell(i, 1) = Split(UnqArray(i), ",")
Next
This then built up an array using data from different ranges and splitting up comma separated ones before outputting only the unique ones.