In my Workbook i have an Array which stores machines. With a button i am able to add some machines to the array.
The final array is used in three other buttons, each button is on a different worksheet. My question now is, how do i store the array global with its changing value?
this is my code for adding some value to the array:
Private Sub Add_Machine_Click()
Dim ws As Worksheet
Dim lastrow As Long
Dim Machine() As Variant
Dim DataRange As Range
Set ws = Worksheets("MachineTemplate")
lastrow = ws.Cells(Rows.Count, "A").End(xlUp).Row
Set DataRange = ws.Range("A1:A" & lastrow)
Set Cell = DataRange.Find(What:=ComboBox1.Value, LookIn:=xlFormulas, lookat:=xlWhole)
If Cell Is Nothing Then
ws.Range("A" & lastrow + 1) = ComboBox1.Value
End If
ReDim Machine(DataRange.Cells.Count)
For Each Cell In DataRange.Cells
Machine(x) = Cell.Value
x = x + 1
Next Cell
End Sub
Right now i use the same code for the other three buttons. is there a way i can store this code as global?
I allready tried it in the WorkbookSheet like this:
Option Explicit
Public Machine() As Variant
Public ws As Worksheet
Public lastrow As Long
Public DataRange As Range
ws = Worksheets("MachineTemplate")
lastrow = ws.Cells(Rows.Count, "A").End(xlUp).Row
Set DataRange = ws.Range("A1:A" & lastrow)
ReDim Machine(DataRange.Cells.Count)
x = 0
For Each Cell In DataRange.Cells
Machine(x) = Cell.Value
x = x + 1
Next Cell
But i know that this is totally wrong.
You do not need a Global Array for this. Since you are using Redim without Preserve, then it means it is getting initialzed everytime from the range DataRange
Also to create the array, you do not need to loop trough it everytime. You can directly create a 2D array in one line
Dim Machine as Variant
Machine = DataRange.Value
You may also want to see VBA Arrays And Worksheet Ranges
I usually avoid using Global variables. They get reset very easily during runtime if an error happens.
Related
I have the following problem: I imported a .csv file with my data into a separate worksheet called "Import".
In this QueryTable, I have the second column called "KW", which indicates the weeknumber for every row.
Now I wanted to populate an array with the cell values from the second column.
I need to make it dynamic, because the length of the array changes with each import.
So far I made the code below:
Sub PopulatingArrayVariable()
Dim myArray() As Variant
Dim TempArray() As Variant
Dim myTable As ListObject
Dim x As Long
Sheets("Import").Activate
Set myTable = ActiveSheet.ListObjects("database_all")
TempArray = myTable.DataBodyRange.Columns(2)
myArray = Application.Transpose(TempArray)
For x = LBound(myArray) To UBound(myArray)
Debug.Print myArray(x)
Next x
End Sub
I get the "runtime error 13": types not compatible
I get the error, but I don't know what exactly I need to change. Can someone please help me solve this?
Fix the Dim and use Set:
Sub PopulatingArrayVariable()
Dim myArray() As Variant '*** will be a 1D VBA array
Dim TempArray As Range '*** typical 2D range variable as part of a column
Dim myTable As ListObject
Dim x As Long
Sheets("Import").Activate
Set myTable = ActiveSheet.ListObjects("database_all")
Set TempArray = myTable.DataBodyRange.Columns(2)
myArray = Application.Transpose(TempArray)
For x = LBound(myArray) To UBound(myArray)
Debug.Print myArray(x)
Next x
End Sub
I would use an arraylist instead as it provides more flexibility. For example you can do something like this:
Sub test()
Dim arr As Object
Dim i As Long
Dim j As Long
Dim lastRow As Long
Set arr = CreateObject("System.Collections.ArrayList")
lastRow = Cells(Rows.Count, 2).End(xlUp).Row
j = 2
'Filling arrayLists
For i = 2 To lastRow
arr.Add ActiveSheet.Cells(i, 2)
Next i
'Read from arrayLists
For i = 0 To arr.Count - 1
Cells(j, 3) = arr(i)
j = j + 1
Next i
End Sub
Customize the code as required. It should resolve your issue.
I would like to create an array of type worksheet, not variant, then populate the array using the Array function and finally pass the array to the worksheet.copy function to crate a new workbook of the worksheets in the array variables.
The following code works but none of the arrays are of type worksheet and two of the example arrays are populated with the worksheet names.
Dim wbkThis As Workbook
Dim wstX As Worksheet
Dim wstY As Worksheet
Dim wstZ As Worksheet
Dim arrWSA As Variant
Dim arrWSB() As Variant
Dim arrWSC(1 To 3) As Variant
Cancel = True
Set wbkThis = ThisWorkbook
Set wstX = wbkThis.Worksheets("SheetX")
Set wstY = wbkThis.Worksheets("SheetY")
Set wstZ = wbkThis.Worksheets("SheetZ")
ReDim arrWSA(1 To 3) As Variant
ReDim arrWSB(1 To 3) As Variant
arrWSA = Array(wstX, wstY, wstZ)
arrWSB = Array(wstX.Name, wstY.Name, wstZ.Name)
arrWSC(1) = wstX.Name
arrWSC(2) = wstY.Name
arrWSC(3) = wstZ.Name
arrWSA(1).Copy
Worksheets(arrWSB()).Copy
Worksheets(arrWSC()).Copy
While you can create an array of worksheets, it won't work to copy them all at once (though you could copy them in a loop). An array of names is the way to go if you want to copy multiple sheets at once.
Sub CopySheets()
Dim shtCount As Long: shtCount = Worksheets.Count
Dim X As Long
Dim arrSheets() As Worksheet: ReDim arrSheets(1 To shtCount)
For X = LBound(arrSheets) To UBound(arrSheets)
Set arrSheets(X) = Worksheets(X)
Next X
' Worksheets(arrSheets).Copy After:=Worksheets(shtCount) 'This won't work.
For X = LBound(arrSheets) To UBound(arrSheets)
arrSheets(X).Copy After:=Worksheets(shtCount) 'this will
Next X
Dim arrShtNames() As String: ReDim arrShtNames(1 To shtCount)
For X = LBound(arrShtNames) To UBound(arrShtNames)
arrShtNames(X) = Worksheets(X).Name
Next X
Worksheets(arrShtNames).Copy After:=Worksheets(shtCount) 'this will as well
End Sub
Try as I might I cannot correct a "Subscript out of Range" error that the code below is throwing on the last line of code below when I try to expand the size of an array with Redim Preserve. Any ideas as to what might be wrong?
Sub Demo()
'Set Excel variables
Dim wb As Workbook: Set wb = ActiveWorkbook
Dim wsCluster As Worksheet: Set wsCluster = wb.Worksheets("Cluster")
Dim initialK As ListObject: Set initialK = wsCluster.ListObjects("k")
'Set Array variables
Dim kArray() As Variant
ReDim kArray(1 To initialK.DataBodyRange.Rows.Count, 1 To initialK.DataBodyRange.Columns.Count)
kArray = initialK.DataBodyRange
'Set Other variables
Dim coordResults As Variant, kResults As Variant, addKs As Variant, dupeArray As Variant
Dim transferLat As Double, transferLong As Double, potDupeCount As Long, expandK As Long, nextAvailK As Long
'Run the assignment function once, then loop through average/assign functions
coordResults = Assign(coordArray, kArray)
For i = 1 To 3
kResults = Average(coordArray, kArray, coordResults)
coordResults = Assign(coordArray, kArray)
Next i
'Run the radius function
addKs = AdjustForRadius(coordArray, kResults, coordResults)
'Add the new, deduped centroid data to the kResults array
expandK = UBound(addKs, 1) + UBound(kArray, 1)
ReDim Preserve kArray(1 To expandK, 1 To 3)
End Sub
The functions are working properly. The "expand" variable is good.
I have tested everything I know.
Jake
I have a code for an array that saves all the data from my spreadsheet in columns D to I, however it also saves all of the blank cells from the sheet too which I don't want. All of the columns have the same number of rows, but ideally I want the array for every row from the second until it finds the last repetition of the max that it works out from column D. My code is:
Sub PopulatingArrayVariable()
Dim myArray() As Variant
Dim DataRange As Range
Dim cell As Range
Dim x As Long
Dim TotalTargets As Double
TotalTargets = WorksheetFunction.Max(Columns("D"))
Set DataRange = Sheets("Result").Range("D:I")
For Each cell In DataRange.Cells
ReDim Preserve myArray(x)
myArray(x) = cell.Value
x = x + 1
Next cell
End Sub
Here's an alternative approach which should skip ReDim Preserve altogether.
See if it helps your situation.
Sub BuildArray()
Dim lngLastRow As Long
Dim rng As Range
Dim arList As Object
Dim varOut As Variant
lngLastRow = Sheets("Result").Range("D:I").Find("*", Sheets("Result").Range("D1"), , , xlByRows, xlPrevious).Row
Set arList = CreateObject("System.Collections.ArrayList")
For Each rng In Sheets("Result").Range("D1:I" & lngLastRow)
If Len(Trim(rng.Value)) > 0 Then
arList.Add rng.Value
End If
Next
varOut = arList.ToArray
End Sub
Add a condition for the length of the cell before adding to the array:
For Each cell In DataRange.Cells
If Len(Trim(Cells)) > 0 Then
ReDim Preserve myArray(x)
myArray(x) = cell.Value
x = x + 1
End If
Next cell
The Trim() would remove the spaces from left and right, thus if there is a cell with just one space like this it would still give 0 and would not be taken into account.
Trim MSDN
I have a function that fills a certain array with cell values depending on which OptionButton is selected. How would I reference those same arrays in a seperate function which would feed those values back into the cells? Here is my (working) code so far.
Private Sub CommandButton1_Click()
Dim wave1Array(0 To 30) As String
Dim wave2Array(0 To 30) As String
Dim wave3Array(0 To 30) As String
Dim wave4Array(0 To 30) As String
Dim wave5Array(0 To 30) As String
Dim rng As Range
Dim cell As Range
Dim counter As Long
Set rng = Range("B2", "AF2")
counter = 0
If OptionButton6.Value = True Then
For Each cell In rng
wave1Array(counter) = cell.Value
counter = counter + 1
Next cell
ElseIf OptionButton7.Value = True Then
For Each cell In rng
wave2Array(counter) = cell.Value
counter = counter + 1
Next cell
ElseIf OptionButton8.Value = True Then
For Each cell In rng
wave3Array(counter) = cell.Value
counter = counter + 1
Next cell
ElseIf OptionButton9.Value = True Then
For Each cell In rng
wave4Array(counter) = cell.Value
counter = counter + 1
Next cell
ElseIf OptionButton10.Value = True Then
For Each cell In rng
wave5Array(counter) = cell.Value
counter = counter + 1
Next cell
End If
End Sub
You have a few different options that I can think of.
As others have mentioned, make a module-level variable(s) as needed. These declarations should go in the same code module as your form controls. If the form controls are on a userform, then they should be declared in the form's code module, not a "standard" module.
'-------------------------------- all in the same code module -------------
Option Explicit
Dim myVariable as String
Private Sub CommandButton1_Click()
myVariable = "Hello, world!"
End Sub
Private Sub CommandButton2_Click()
msgBox myVariable
End Sub
'------------------------------- end of this example ----------------------
Public/GLobal variable may be an option but I recall there are some limitations using these with UserForms, and since I'm not sure if you're using a UserForm, I won't recommend that.
A third option would be to pass the arguments from one procedure to another, but that usually only works with "chained" procedures/functions, like when one function calls another function and that does not seem to be what you're doing at all.
For your specific case:
You can also streamline your code to avoid using the counter and cell variables, using direct range-to-array assignment.
'Module-level array variables, accessible by other procedures in this module:
Dim wave1Array()
Dim wave2Array()
Dim wave3Array()
Dim wave4Array()
Dim wave5Array()
Dim wave6Array()
Private Sub CommandButton1_Click()
Dim rng As Range
Dim arr()
Set rng = Range("B2", "AF2")
'## Converts the row to an array (0 to 30)
arr = Application.Transpose(Application.Transpose(rng.Value))
'## Assigns the array from above to one of the module-level array variables:
If OptionButton6.Value = True Then wave1Array = arr
If OptionButton7.Value = True Then wave2Array = arr
If OptionButton8.Value = True Then wave3Array = arr
If OptionButton9.Value = True Then wave4Array = arr
If OptionButton10.Value = True Then wave5Array = arr
If OptionButton11.Value = True Then wave6Array = arr
End Sub
Note that to do this, you will have to declare them as variant arrays, since a range of cells .Value is a variant type (cells can contain error values which I believe will fail if you try to assign to a string array).
IF you must use strict String arrays, then you will need to use the counter and cell iteration.