Closed. This question needs debugging details. It is not currently accepting answers.
Edit the question to include desired behavior, a specific problem or error, and the shortest code necessary to reproduce the problem. This will help others answer the question.
Closed 2 years ago.
Improve this question
I am looking across numerous columns and rows and inputting cell values of interest into a 1D array. I would just like to print this array of length 2020 into a single row on another worksheet. I am not sure why my program is not working, but I appreciate any help
Sub Math()
Dim FW_List() as Variant
x = 0
For i = 3 to 10
For j = 17 to 282
If Left(ws.Cells(j, i).Value, 3) = "0.7" And ws.Cells(j, i).Interior.Color <> 8696025 Then
ReDim Preserve FW_List(x)
FW_List(x) = ws.Cells(j, i).Value
x = x + 1
Next j
Next i
num = UBound(FW_List) - LBound(FW_List) + 1
Debug.Print num
wb.Sheets("JMP").Range("A1:A2020").Value = Application.WorksheetFunction.Transpose(FW_List)
End Sub
Your code is quite good but it lacks precision. Some of the changes I made are cosmetic, like the use of a With statement to shorten the code and thereby make it easier to read. But the nonchalance with which you approached variable naming probably caused your failure. Observe that I retained both structure and logic of your original code.
Sub Math()
Dim FW_List As Variant
Dim Ws As Worksheet
Dim C As Long ' loop counter: column
Dim R As Long ' loop counter: Row
Dim i As Long ' index of FW_List
Set Ws = ActiveSheet
ReDim FW_List(1 To 3000) ' any number larger than what you expect
For C = 3 To 10
For R = 17 To 282
With Ws.Cells(R, C)
If Left(.Value, 3) = "0.7" And .Interior.Color <> 8696025 Then
i = i + 1
FW_List(i) = .Value
End If
End With
Next R
Next C
If i Then
ReDim Preserve FW_List(i)
Worksheets("JMP").Cells(1, 1).Resize(1, i).Value = Application.Transpose(FW_List)
End If
End Sub
But here are two things you probably couldn't have known.
Dim FW_List As Variant creates a variant which, as you know, can be anything including an array. Therefore Dim FW_List() As Variant creates an array of such variants. Since any of its components can do what the whole structure does the idea isn't useful and therefore any difference it can make not beneficial.
When you Redim Preserve an array the entire array is re-written to a new one, element by element. As the size of your array grows to 2020 elements that process eats time if repeated 2000 times. Therefore my code creates an array intentionally larger than what is needed and then truncates unused elements - a process I believe is done without re-writing the array at all.
Related
This question already has an answer here:
Search for an element in the VBA ArrayList
(1 answer)
Closed 2 years ago.
I was trying to delete the specific element in the array vba when certain condition are true but i end up getting error 424. May I know the right way to do it? I tired to use redim, however it doesn't suit my condition as after the comparing with others array i need to store the data back into excel file where the location in the excel file is already sorted.
Before changing the remarkRange to array variant, I used it as Dim remarkRange
As Range where I can just use .Clear to clear the range item in a specific element.
I tried remarkRange(I, 1)=" " it runs without error but im not sure if its suitable. May I know the correct way to do it? Thanks.
Dim remarkRange() As Variant
remarkRange= wb.Sheets("wb").Range("A1:A5").Value2
For I = LBound(remarkRange) To UBound(remarkRange)
If (some condition is true) then
remarkRange(I, 1).Delete
End If
Next I
I expected the element in the specific cell in the array to be empty, but I got error 424
An array doesn't have a Delete method. It's also misleading to have the Range in remarkRange when it's an array, not a Range. Maybe a different name, e.g. remarks or whatever is clear to you.
If you're going to write the array back to the worksheet, then I see no problem changing an element to a blank string.
For i = LBound(remarks, 1) To UBound(remarks, 1)
If some condition Then
remarks(i, 1) = ""
End If
Next i
It seems you'll need to decide what you mean by 'delete'. I'm not aware of a Delete property of an array of variants so while your code might compile it would throw an object required error.
However, your point about previously using the Clear method on a Range object, suggests that you just want to read your range values into an array, remove the contents if certain conditions aren't me, and then re-write your array to the range. If that's the case, you probably wouldn't want to resize your array as the rows or columns wouldn't line up - more commonly, you'd set the item of your variant array to Empty.
The code below shows how to do this in a simple routine of taking 10 numbers from column A, removing all odd numbers and re-writing the numbers to Column C - but with the rows still matching:
Public Sub EmptyItemsAndKeepArraySize()
Dim inArr() As Variant
Dim i As Long
'Read range into arrays.
inArr = Sheet1.Range("A1:A10").Value2
'Clear all numbers that are not even.
For i = 1 To UBound(inArr, 1)
If inArr(i, 1) Mod 2 <> 0 Then inArr(i, 1) = Empty
Next
'Write cleared array to column C
Sheet1.Range("c1").Resize(UBound(inArr, 1)).Value = inArr
End Sub
If, however, you really do want to remove and resize your array, then a simple way of doing it is to populate a temporary collection first, resizing an output array and then populating that with the collection items. In the example below the code removes all odd numbers and then writes the array to column B - but as an array reduced in size (ie contiguous rows):
Public Sub DeleteItemsAndShrinkArray()
Dim inArr() As Variant, outArr() As Variant
Dim i As Long
Dim temp As Collection
Dim v As Variant
'Read range into arrays.
inArr = Sheet1.Range("A1:A10").Value2
'Keep all even numbers in a temporary collection.
Set temp = New Collection
For i = 1 To UBound(inArr, 1)
If inArr(i, 1) Mod 2 = 0 Then temp.Add inArr(i, 1)
Next
'Dimension the output array.
ReDim outArr(1 To temp.Count, 1 To 1)
'Populate new array from temp collection.
i = 1
For Each v In temp
outArr(i, 1) = v
i = i + 1
Next
'Write reduced array to column B
Sheet1.Range("B1").Resize(UBound(outArr, 1)).Value = outArr
End Sub
I have a a table of values, which list item ids by the amount of those items in different qualities, like so:
ID QB QC UI
006780 12 - 6
100780 48 15 8
And so on for a thousand rows. As part of a further wrangling effort, I wish to get the id's and move them elsewhere and position them under each other with 2 blank cells between them. This is the code I've come up with and please bear with me, I'm trying to lear:
Sub laatuJako()
Dim idRange As Range
Dim tyoWb As Workbook
Dim tyoWks As Worksheet
Dim idRivit As Integer
Dim idArray() As Variant
Set tyoWb = ThisWorkbook
Set tyoWks = tyoWb.Sheets("Pivots->Apu")
idRivit = tyoWks.Range("Q7").End(xlDown).Row
ReDim idArray(0)
Dim varCounter As Integer
varCounter = 0
This next loop is a way I could form the array, since it seemed to run into run-time error 9 in the next loop.
For i = 0 To idRivit - 1
tyoWks.Activate
idArray(i) = tyoWks.Range("Q" & 7 + i).Value
varCounter = varCounter + 1
ReDim Preserve idArray(varCounter)
Next i
Dim k As Integer
Dim j As Integer
k = 0
j = 0
Do While k < idRivit
tyoWks.Range("X" & 7 + j).Value = idArray(k)
j = j + 3
k = k + 1
Loop
End Sub
Now the code works, but it seems that (un)helpfully VBA changed the id attribute to a number and printed the ids with numbers in front of them, for example 006780 as 6780. This was not wanted and so I changed the array into a string array, but it made no difference. Now an array is not necessary here and I can just copy-paste them directly using a loop, but I want to understand how I can control something like this, since the issue will come up again in situations where an array would be preferable.
Apologies, if the question is poorly described, there is a first time for everything.
So I have an array with a lot of data, I used to write the data to excel sheet via for cycle, but it took too long, so I looked into faster alternatives.
Now I try to display the information with setting a value of range of cells directly to array:
Sub displayRandomMatrix(clientsColl As Collection, resultWorkbook As Workbook)
Dim NamesRange As Range
With resultWorkbook.Worksheets("matrix_random")
...
Set NamesRange = _
.Range(.Cells(2, 1), .Cells(clientsColl.Count + 1, 1))
Dim NamesArray() As String
ReDim NamesArray(1 To clientsColl.Count)
Dim clientRow As Long
Dim simulation As Long
clientRow = 1
simulation = 1
Dim clientCopy As client
For Each clientCopy In clientsColl
For simulation = 1 To clientCopy.getRandomNumbers.Count
...
Next
NamesArray(clientRow) = clientCopy.getClientName
clientRow = clientRow + 1
Next
...
NamesRange.value = NamesArray
...
End With
'debugging
Debug.Print "**************start"
For clientRow = 1 To clientsColl.Count
Debug.Print NamesArray(clientRow)
Next
Debug.Print "**************end"
End Sub
However when I then open a resultWorkbook I see that the same client's name is written in all the needed cells of the 1st column. At the same the debug section of the code produces correct output - there are correct multiple clients names in that array.
So something gets broken when I assign that array to a range: NamesRange.value = NamesArray.
At the same time I do similar thing with other arrays and it works, but this while comes out with the bug.
What might be the reason?
NOTE: clientsColl is a good, correct collection of Clients. There is nothing wrong with it, neither is with resultWorkbook.
NamesArray is a horizontal array, which you are trying to assign to a vertical range. Try using Application.Transpose
NamesRange.value = Application.Transpose(NamesArray)
Transpose is a quick fix but has its limitations. So if that does not work you will need to force a vertical array by declaring a 2nd dimension in your array:
ReDim NamesArray(1 To clientsColl.Count, 1 to 1)
Then when you fill it make sure to include the second dimension:
NamesArray(clientRow,1) = clientCopy.getClientName
Then you can assign it as you have:
NamesRange.value = NamesArray
Respected Experts, I want to store each value in VBA-Array which is calculated by VBA Loop. after the looping is Done I would like to use that VBA-Array for my further Calculations.Below example explain my question more specifically.
Sub macro3()
For x = 1 To 5
xx = 1 + x
Next
End Sub
Basically the each Answer which derived i.e.(2,3,4,5,6) from above loop has to be stored in Particular Array OR in something which help me out to use each value's i.e.(2,3,4,5,6) again for my further calculations.The whole activity has to be done from VBA memory Only.Basically i don't want to use Excel Spreadsheet range to store the each Loop Value and then define that spreadsheet range as Array.
If you know the number of elements, then the following would create an array called 'answer' (see DIM statement) that holds the five evaluations:
Sub macro3()
Dim answer(1 To 5)
For x = 1 To 5
answer(x) = 1 + x
Next
End Sub
I suspect though that what you're after might be a little more complicated than that, so give more detail if this is the case.
In addition to CLR's answer - if you dont' know the number of elements the basic formula to ReDim the array would look something like this -
Sub macro3()
Dim x As Integer
Dim xx() As Variant
For x = 1 To 5
ReDim Preserve xx(0 To x - 1)
xx(x - 1) = 1 + x
Next
End Sub
I am trying to find the fastest way to perform a task in VBA. Currently I have it written as a nested for loop which can be extremely slow. I am looping over a list of unique numbers and matching them to numbers in a different list. If I get a match I store the information in a multidimensional array since there can be multiple matches and I want to keep track of all of them. Unfortunetly, this means when using a for loop if there are just 1000 unique numbers and 5000 numbers to look for matches my loop can end up iterating 1000*5000 = 5000000 times. As you see this can create a problem quickly. I am asking if there is any better way to approach this problem while staying in VBA. I already did all the tricks like set screenUpdating to false and calculation to manaul.
Here is my code:
For x = 0 To UBound(arrUniqueNumbers)
Dim arrInfo() As Variant
ReDim Preserve arrInfo(0)
If UBound(arrInfo) = 0 Then
arrInfo(0) = CStr(arrUniqueNumbers(x))
End If
For y = 2 To Length
UniqueString = CStr(arrUniquePhoneNumbers(x))
CLEARString = CStr(Sheets(2).Range("E" & y).Value)
If UniqueString = CLEARString Then 'match!
NormalizedDate = Format(CStr(Sheets(2).Range("G" & y).Value), "yyyymmdd")
z = z + 1
ReDim Preserve arrInfo(z)
arrInfo(z) = NormalizedDate & " " & LTrim(CStr(Sheets(2).Range("D" & y).Value))
arrInfo(z) = LTrim(arrInfo(z))
End If
Next
arrUniqueNumbers(x) = arrInfo()
ReDim arrInfo(0) 'erase everything in arrOwners
z = 0
Next
The loop is quite inefficient, so there are quite a few avoidable bottlenecks (mostly in the order of simplest to change to most complex to change)
Take the UniqueString step out of the innermost loop: This step doesn't change with changing y, so no point in repeating it.
Take the Redim Preserve out of the innermost loop: You are reallocating memory in the innermost loop which is extremely inefficient. Allocate 'sufficient' amount of memory outside the loop.
Do not keep using Sheets().Range() to access cell contents: Every time you access something on the spreadsheet, it is a HUGE drag and has a lot of overhead associated with the access. Consider one-step fetch operations from the spreadsheet, and one-step push operations back to the spreadsheet for your results. See sample code below.
Sample code for Efficient Fetch and Push-back operations for the spreadsheet:
Dim VarInput() As Variant
Dim Rng As Range
' Set Rng = whatever range you are looking at, say A1:A1000
VarInput = Rng
' This makes VarInput a 1 x 1000 array where VarInput(1,1) refers to the value in cell A1, etc.
' This is a ONE STEP fetch operation
' Your code goes here, loops and all
Dim OutputVar() as Variant
Redim OutputVar(1 to 1000, 1 to 1)
' Fill values in OutputVar(1,1), (1,2) etc. the way you would like in your output range
Dim OutputRng as Range
Set OutputRng = ActiveSheet.Range("B1:B1000")
' where you want your results
OutputRng = OutputVar
' ONE STEP push operation - pushes all the contents of the variant array onto the spreadsheet
There are quite a few other steps which can further dramatically speed up your code, but these should produce visible impact with not too much effort.
dim dict as Object
set dict = CreateObject("Scripting.Dictionary")
dim x as Long
'Fill with ids
'Are arrUniqueNumbers and arrUniquePhoneNumbers the same?
For x = 0 To UBound(arrUniqueNumbers)
dict.add CStr(arrUniquePhoneNumbers(x)), New Collection
next
'Load Range contents in 2-Dimensional Array
dim idArray as Variant
idArray = Sheets(2).Cells(2,"E").resize(Length-2+1).Value
dim timeArray as Variant
timeArray = Sheets(2).Cells(2,"G").resize(Length-2+1).Value
dim somethingArray as Variant
somethingArray = Sheets(2).Cells(2,"D").resize(Length-2+1).Value
dim y as Long
'Add Values to Dictionary
For y = 2 To Length
Dim CLEARString As String
CLEARString = CStr(timeArray(y,1))
If dict.exists(CLEARString) then
dict(CLEARString).Add LTrim( Format(timeArray(y,1)), "yyyymmdd")) _
& " " & LTrim(CStr(somethingArray(y,1)))
end if
next
Access like this
dim currentId as Variant
for each currentId in dict.Keys
dim currentValue as variant
for each currentValue in dict(currentId)
debug.Print currentId, currentValue
next
next