my code copies all the values of a table in excel on an array an filter them and fill a combobox with it, but I keep geting this error on my code and after debuging it's seems that the error is due to Redim Preserve ... can you check it please ?
' FIll CB2()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("D1")
Dim LC As Long
Dim i As Long
Dim PN As Long
Dim myArray() As String
Dim j As Long
Dim k As Long
Dim temp As String
LC = ws.Cells(ws.Rows.Count, 4).End(xlUp).Row
For i = 1 To LC
If StrComp(CB1.List(CB1.ListIndex, 0), ws.Cells(i, 4), vbTextCompare) = 0 Then
'Set you array with the right dimension
ReDim Preserve myArray(0 To PN, 0 To 1)
myArray(PN, 0) = ws.Cells(i, 2)
myArray(PN, 1) = ws.Cells(i, 3)
PN = PN + 1
End If
Next i
End Sub
There is nothing to "Preserve" when the Redim statement is called for the first time in your loop. Call Redim without "Preserve" when you dimension the array for the first time.
If the line of code that dimensions variables is real code it is surprising that it doesn't call an error. I suggest to place each Dim statement in a line by itself, for better readability of the code if for no other reason, and avoid the use of the colon quite generally but especially for the purpose of mixing declarations with value assignment.
Related
I’ve been experimenting with arrays to find a faster alternative to VLOOKUP(), which can take a long time to execute with very large data sets.
I searched SO and many other sites, grabbing snippets of code.
The data:
A1:A5 the list of values to lookup (1,2,3,4,5)
C1:C5 the range to ‘find’ the values (2,4,6,8,10)
D1:D5 the range of values to ‘return’ (a,b,c,d,e)
B1:B5 is where I’d like to paste the ‘looked-up’ values.
The code works up to a point, in that it does return correct values for the ‘looked-up’ value’s position in C1:C5 – and the correct values in the adjacent cells in D1:D5.
When I try to load the returned values to Arr4 (the array to be pasted back to the sheet) which is saying <Type mismatch> when I hover the mouse over it. It doesn’t stop the code from executing, but it doesn’t paste anything.
My questions are:
How do I populate the array Arr4 with the myVal2 values, and
How do I paste it back to the sheet?
Option Explicit
Sub testArray()
Dim ArrLookupValues As Variant
ArrLookupValues = Sheet1.Range("A1:A5") 'The Lookup Values
Dim ArrLookupRange As Variant
ArrLookupRange = Sheet1.Range("C1:C5") 'The Range to find the Value
Dim ArrReturnValues As Variant
ArrReturnValues = Sheet1.Range("D1:D5") 'The adjacent Range to return the Lookup Value
Dim ArrOutput As Variant 'output array
Dim UpperElement As Long
UpperElement = UBound(ArrLookupValues) 'Used purely for the ReDim statement
Dim i As Long
For i = LBound(ArrLookupValues) To UBound(ArrLookupValues)
Dim myVal As Variant
myVal = ArrLookupValues(i, 1)
Dim pos As Variant 'variant becaus it can return an error
pos = Application.Match(myVal, ArrLookupRange, 0) 'pos always returns the correct position
Dim myVal2 As Variant
If Not IsError(pos) Then
myVal2 = ArrReturnValues(pos, 1) 'myVal2 always returns the correct value
ReDim Preserve ArrOutput(1 To UpperElement, 1 To 1)
ArrOutput(i, 1) = myVal2
Else
ReDim Preserve ArrOutput(1 To UpperElement, 1 To 1)
myVal2 = "Not Found"
ArrOutput(i, 1) = myVal2
End If
Next i
Dim Destination As Range
Set Destination = Range("B1")
Destination.Resize(UBound(ArrOutput, 1), UBound(ArrOutput, 2)).Value =
ArrOutput
End Sub
According to #T.M 's answer, you can even do that without looping just by using VLookup instead of Match:
Public Sub testArraya()
With Sheet1
Dim ArrLookupValues() As Variant
ArrLookupValues = .Range("A1:A5").Value ' lookup values 1,2,3,4,5,6
Dim ArrLookupReturnRange() As Variant ' lookup range items 2,4,6,8,10
ArrLookupReturnRange = .Range("C1:D5").Value ' And return column D a,b,c,d,e
End With
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'[1] Match all values at once and return other values of column D
' (found position indices or Error 2042 if not found)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Dim ArrOutput() As Variant
ArrOutput = Application.VLookup(ArrLookupValues, ArrLookupReturnRange, 2, 0)
'[3] write results to any wanted target
Dim Destination As Range
Set Destination = Sheet1.Range("B1") ' ‹‹ change to your needs
Destination.Resize(UBound(ArrOutput, 1), UBound(ArrOutput, 2)).Value = ArrOutput
End Sub
Or even extremly shortened and almost a one liner:
Public Sub testArrayShort()
Const nRows As Long = 5 'amount of rows
With Sheet1
.Range("B1").Resize(nRows).Value = Application.VLookup(.Range("A1").Resize(nRows).Value, .Range("C1:D1").Resize(nRows).Value, 2, 0)
End With
End Sub
Use proper error handling and an If statement instead of On Error Resume Next.
Also your Arr4 needs to be 2 dimensional like your other arrays. Even if it is only one column it needs no be Arr4(1 To UpperElement, 1 To 1) and Arr4(i, 1) = myVal2. Ranges are always 2 dimensional (row, column) even if there is only one column.
And I highly recommend to rename your array variables. When ever you feel like you have to give your variable numbers, you can be sure you are doing it wrong.
Rename them like following for example:
Arr1 --› ArrLookupValues
Arr2 --› ArrLookupRange
Arr3 --› ArrReturnValues
Arr4 --› ArrOutput
This is only a simple modification but your code will extremely gain in human readability and maintainability. You even don't need comments to describe the arrays because their names are self descriptive now.
Finally your output array can be declared the same size as the input arrays. Using ReDim Preserve makes your code slow, so avoid using it.
So something like this should work:
Option Explicit
Public Sub testArray()
Dim ArrLookupValues() As Variant
ArrLookupValues = Sheet1.Range("A1:A5").Value
Dim ArrLookupRange() As Variant
ArrLookupRange = Sheet1.Range("C1:C5").Value
Dim ArrReturnValues() As Variant
ArrReturnValues = Sheet1.Range("D1:D5").Value
Dim UpperElement As Long
UpperElement = UBound(ArrLookupValues, 1)
'create an empty array (same row count as ArrLookupValues)
ReDim ArrOutput(1 To UpperElement, 1 To 1)
Dim i As Long
For i = LBound(ArrLookupValues, 1) To UBound(ArrLookupValues, 1)
Dim FoundAt As Variant 'variant because it can return an error
FoundAt = Application.Match(ArrLookupValues(i, 1), ArrLookupRange, 0) 'pos always returns the correct position
If Not IsError(FoundAt) Then
ArrOutput(i, 1) = ArrReturnValues(FoundAt, 1)
Else
ArrOutput(i, 1) = "Not Found"
End If
Next i
Dim Destination As Range
Set Destination = Range("B1") 'make sure to specify a sheet for that range!
Destination.Resize(UBound(ArrOutput, 1), UBound(ArrOutput, 2)).Value = ArrOutput
End Sub
Just for fun a slight modification of #PEH 's valid approach demonstrating a rather unknown way to excecute a single Match checking both arrays instead of repeated matches:
Public Sub testArray()
With Sheet1
Dim ArrLookupValues As Variant
ArrLookupValues = .Range("A1:A5").Value ' lookup values 1,2,3,4,5,6
Dim ArrLookupRange As Variant ' lookup range items 2,4,6,8,10
ArrLookupRange = .Range("C1:C5").Value
Dim ArrReturnValues As Variant ' return column D a,b,c,d,e
ArrReturnValues = .Range("D1:D5").Value
End With
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'[1] Match all item indices within ArrLookupRange at once
' (found position indices or Error 2042 if not found)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Dim ArrOutput
ArrOutput = Application.Match(ArrLookupValues, ArrLookupRange, 0)
'[2] change indices by return values
Dim i As Long
For i = 1 To UBound(ArrOutput)
If Not IsError(ArrOutput(i, 1)) Then
ArrOutput(i, 1) = ArrReturnValues(ArrOutput(i, 1), 1)
' Else
' ArrOutput(i, 1) = "Not Found" ' optional Not Found statement instead of #NV
End If
Next i
'[3] write results to any wanted target
Dim Destination As Range
Set Destination = Sheet1.Range("B1") '<< change to your needs
Destination.Resize(UBound(ArrOutput, 1), UBound(ArrOutput, 2)).Value = ArrOutput
End Sub
I have written a VBA script to filter entries in an Excel table based on the contents of another one. I understand that although my table contains multiple fields (columns) they are contained within a 1D dynamic array.
I assigned a range in a workbook, and then resized this to reflect the size of the dynamic array. I then try to bulk assign the contents of the dynamic array to the range.
Sub generate_motor_list_from_QlikView_data()
Dim tags As Variant
Dim mtrs() As Variant
Dim msng() As Variant
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim rng As Range
Dim mtrtbl As Range
ReDim Preserve mtrs(i)
ReDim Preserve msng(j)
tags = Worksheets("Backend").Range("Tags[Tag]")
For Each Tag In tags
Set rng = Worksheets("QlikView").Range("QlikView[Tag]").Find(What:=Tag, LookIn:=xlValues, LookAt:=xlWhole)
If rng Is Nothing Then
msng(j) = Tag
j = j + 1
ReDim Preserve msng(j)
' do something !
Else
Set mtrs(i) = Worksheets("QlikView").ListObjects("QlikView").ListRows(rng.Row - 1)
i = i + 1
ReDim Preserve mtrs(i)
End If
Next Tag
Set mtrtbl = Worksheets("Backend").Range("F18")
mtrtbl.Resize(UBound(mtrs, 1), 1) = mtrs
End Sub
The debugger brings up this message, on the line mtrtbl.Resize(UBound(mtrs, 1), 1) = mtrs
Run-time error '1004':
Application-defined or object-defined error"
This is my first time using array in VBA. I was trying to check the value of my array based on certain condition.
I check my array value through the Locals Window. The window is empty. What did I do wrong?
Option Explicit
Sub test()
'define dynamic array
Dim sn As Variant
Dim i As Long
'Loop through all the row
For i = 1 To Rows.Count
If Cells(i, 12).Value = "Renewal Reminder" And Not IsEmpty(Cells(i, 12).Value) Then
'assign cell value to array
sn = Cells(i, 1).Value
Debug.Print "aaa" ' there are 8 cell values that meet the condition
End If
Next i
End Sub
Update
Dim sn as Varient was highlighted with Error
user-defined type not defined
Apart from the typo showing in the error message, you are not actually using sn as an array - you are simply storing each value in a scalar variable, replacing what was previously in that variable.
The following should work for you:
Option Explicit
Sub test()
'define dynamic array
Dim sn As Variant
Dim cnt As Long
Dim i As Long
ReDim sn(1 To 1)
cnt = 0
'Loop through all the row
For i = 1 To Cells(Rows.Count, "L").End(xlUp).Row
If Cells(i, 12).Value = "Renewal Reminder" Then
'assign cell value to array
cnt = cnt + 1
ReDim Preserve sn(1 To cnt)
sn(cnt) = Cells(i, 1).Value
Debug.Print "aaa" ' there are 8 cell values that meet the condition
End If
Next i
For i = 1 To cnt
Debug.Print sn(i)
Next
End Sub
As mentioned in the answer by Chemiadel, it is better to declare your variables using the appropriate base type if you know what that is.
So, if you know that column A contains text, replace Dim sn As Variant with
Dim sn() As String
or, if it is a double-precision number, use
Dim sn() As Double
etc. If column A could contain various different types, using Variant could be appropriate.
Note: You don't have to include the () when using Variant because Variant variables can switch happily between being scalars, arrays, objects, etc.
You need to declare Array with this way and avoid Variant data type :
Static Array : fixed-size array
dim sn(10) as String
Dynamic Array : you can size the array while the code is running.
dim sn() as String
Use ReDim Preserve to expand an array while preserving existing values
ReDim Preserve sn(UBound(sn) + 10)
Check the reference
I am a totally newbie in Vba and need to solve a specific problem with a macro and vba. I hope, you can help me with this problem!
I try to built a macro which should help me with this steps:
I use a "cockpit-file" with which I want to substract all cells from two worksheets with eachother. I get the worksheets from two different workbooks. ;-) As an example: I want to subtract the cell F11 (Workbook1.Worksheet1) from F11 (Workbook2.Worksheet1), than F12 (workboosk1.worksheet1) from F12 (Workbook2.Worksheet1), [...] J34 (Wb1.ws1.) from J34(Wb2.ws.1)
I want to change and select the files. Therefore I need window in which one I can select the specific files.
To avoid errors the math should be done via Arrays in vba. And the new Value should be added in one of the workbooks
I tried to use a Loop to solve the problem with the math but it doesn't work. When I come to the subtractionformula I get the runtime error 13.
Hope you can help me! Sorry for my bad english
Thats my code
Sub Makro4()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'Variabledef
Dim i As Long 'Index
Dim j As Long 'Index
Dim k As Long 'Index
Dim ArrayA As Variant 'Array
Dim ArrayB As Variant 'Array
Dim ArrayC As Variant 'Array
Dim MyFile1 As String 'Workbookname
Dim MyFile2 As String 'Workbookname
Dim wb1 As String 'Workbookname
Dim wb2 As String 'Workbookname
Dim WS_Count1 As Integer 'Count Worksheets
Dim WS_Count2 As Integer 'Count Worksheets
Dim arrays1 As String 'Dimension
Dim arrays2 As String 'Dimension
'Change the actual path
ChDrive "O:\"
ChDir "O:[.......]\VBA"
'Selection first File
MyFile1 = Application.GetOpenFilename
Workbooks.Open Filename:=MyFile1, ReadOnly:=True, IgnoreReadOnlyRecommended:=True
wb1 = ActiveWorkbook.Name
ArrayA = Workbooks(wb1).Worksheets("01").Range("F11:GL46").Value
WS_Count1 = ActiveWorkbook.Worksheets.Count
'Selection second File
MyFile2 = Application.GetOpenFilename
Workbooks.Open Filename:=MyFile2, ReadOnly:=True, IgnoreReadOnlyRecommended:=True
wb2 = ActiveWorkbook.Name
ArrayB = Workbooks(wb2).Worksheets("01").Range("F11:GL46").Value
WS_Count2 = ActiveWorkbook.Worksheets.Count
' Calculation of the math - Runtime Error 13
For k = 1 To WS_Count1
For i = LBound(ArrayA, 1) To UBound(ArrayA, 1)
For j = LBound(ArrayA, 2) To UBound(ArrayA, 2)
ArrayC(i, j) = ArrayA(i, j) - ArrayB(i, j)
Next j
Next i
Worksheets("k").Range("F11:GL34").Value = ArrayC
Next k
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
ArrayC is not initialized yet. It's defined as Variant, which means, the type is unknown until something gets assigned to the variable.
With this line ArrayC(i, j) = ArrayA(i, j) - ArrayB(i, j) you already assume that ArrayC holds an array, which it doesn't yet.
First define ArrayC in your head like this Dim ArrayC(). this way it's clearly defined as an array. Still without size though.
Now before the line For k = 1 To WS_Count1, you set the dimension of your array this way ReDim ArrayC(UBound(ArrayA,1) ,UBound(ArrayA,2)) This should create an 2D array with the same size as ArrayA.
Now you have a fully initialized array
Now your program should work.
Im coming from a Unix world where I never had to develop something for Office with VBA, I have to do some now and Im having a hard time! Please help me! :)
So I've got 2 Excel Sheets(lets call them Sheet1 and Sheet2) and 2 forms(Form1 and Form2) to edit/add data.
In Sheet1, the first two columns are MovieId and MovieName. We dont know how many rows they will be in this columns.
Form1 controls data in Sheet1, and Form2... in Sheet2.
At Form2 initialization, I want to create a 2 Dimensional Array that will be like (MovieId1,MovieName1;MovieId2,MovieName2;...,...;MovieIdN,MovieNameN), where this data has been extracted from Sheet1, like a sort of Map in Java if you will...
It would actually be ok for me if it was like: (0,"MovieId0;MovieName0";1,"MovieId1,MovieName1";..,"..";N,"MovieIdN,MovieNameN")
I dont know how to create the array with an variable last row number, since the compiler seems to always want a constant to initialize an Array...
Please enlighten me!
Look at the Value method or Value2 property.
e.g. Range("$A$2:$B$4").Value2(1,1)
or
Range("$A$2:$B$4").Value()(1,1)
Array's lower bound start from 1.
lbound(Range("$A$2:$B$4").Value2, 1) - row element starts from
ubound(Range("$A$2:$B$4").Value2, 2) - row element ends
lbound(Range("$A$2:$B$4").Value2, 2) - column element starts from
ubound(Range("$A$2:$B$4").Value2, 2) - column element ends
EDIT: Code to traverse through the array
Dim myAddress As String
Dim dataArray As Variant
Dim rowStart As Long, rowEnd As Long
Dim colStart As Long, colEnd As Long
Dim rowCtr As Long
Dim colCtr As Long
myAddress = "$A$2:$B$4"
dataArray = Range(myAddress).Value2
rowStart = LBound(dataArray, 1)
rowEnd = UBound(dataArray, 1)
colStart = LBound(dataArray, 2)
colEnd = UBound(dataArray, 2)
For rowCtr = rowStart To rowEnd
For colCtr = colStart To colEnd
Debug.Print rowCtr & ":" & colCtr, vbTab & dataArray(rowCtr, colCtr)
Next
Next
EDIT2: In my example, I have assumed the address to be $A$2:$B$4.
You can prefix it with sheet name. e.g. Sheet1!$A$2:$B$4 or Sheet2!$A$2:$B$4
On a side note, array can be defined dynamic (if it is 1 dimensional).
e.g dim my1DArray() as Integer
For double dimension array, see the following code
Dim myArray
Dim dynamicRows As Integer
dynamicRows = 2
ReDim myArray(0 To dynamicRows, 0 To dynamicRows)
myArray(0, 0) = "hello"
dynamicRows = 20
ReDim myArray(0 To dynamicRows, 0 To dynamicRows)
MsgBox myArray(0, 0)
myArray(0, 0) = "hello"
ReDim Preserve myArray(0 To dynamicRows, 0 To dynamicRows)
MsgBox myArray(0, 0)
Rather use the Range object, with this you can also use the UsedRange from the sheet
Sub Macro1()
Dim sheet As Worksheet
Dim range As range
Dim row As Integer
Set sheet = Worksheets("Sheet1")
Set range = sheet.UsedRange
For row = 1 To range.Rows.Count
Next row
End Sub
assuming the data starts in A1
Dim vArr as variant
vArr=worksheets("Sheet1").range("A1").resize(worksheets("Sheet1").range("A65535").end(xlup).row,2)
Do you mean:
Dim thearray() As Variant
ReDim thearray(1, range.Rows.Count)
You can also use a recordset and GetRows to return an array from a worksheet.
Slight mod to Charles' answer:
Dim vArr as variant
vArr = Worksheets("Sheet1").Range("A1").CurrentRegion.Value
Assuming of course that there isn't any stray data in Sheet1.