I'm trying to create array with values from non-empty cells in range B6:B183 . array_articles = ActiveWorsheet.Range("B6:B183") return empty array, so I'm trying to do this:
Sub set_price()
Dim articul_price() As String
Dim articul_bill As String
Dim counter As Integer
Dim array_articles() As Variant
Dim array_unsorted() As String
Dim cell As Range
counter = 0
ReDim articul_price(0)
For Each cell In ActiveWorsheet.Range("B6:B183") ' error 424 Object required
If IsEmpty(cell.Value) Then
array_unsorted(counter) = cell.Value
ReDim Preserve array_unsorted(counter)
Else
'do nothing
counter = counter + 1
End If
Next
End Sub
This code return
error 424 Object required
To easily load a range into an array (without a loop) use:
Dim array_unsorted As Variant 'must be variant!
array_unsorted = ThisWorkbook.Worksheets("NameOfSheet").Range("B6:B183").Value '2-dimensional array
you can access the array with
Debug.Print array_unsorted(row, column) 'yes it has only 1 column but it is still there
Debug.Print array_unsorted(1, 1) 'first value
Debug.Print array_unsorted(2, 1) 'second value
or transpose it to make it 1-dimensional
array_unsorted = WorksheetFunction.Transpose(ThisWorkbook.Worksheets("NameOfSheet").Range("B6:B183").Value) '1-dimensional
and you can access the array with
Debug.Print array_unsorted(i) 'this is 1-dimensional
Debug.Print array_unsorted(1) 'first value
Debug.Print array_unsorted(2) 'second value
Note that the transpose function has a limit of 65,536 rows. If you exceed them the rest will be truncated silently.
I recommend to avoid ActiveWorksheet (unless you write an add-in or the code is used for multiple worksheets). Use ThisWorkbook.Worksheets("NameOfSheet") to reference the worksheet by its name, which is more save and Excel won't run into errors.
Related
Ok, admittedly I am trying this with chatgpt and going in circles. Just trying to solve a work problem, and I am not a programmer. I need to handle data that is numeric and alphanumeric and also in ranges. it appears as such: TU1000-TU1005,23000,2400-2500 etc... I am working with data in an excel document and trying to use VBA to do so. I am trying copy a single selected cells contents, and break it down vertically onto a another sheet. the contents may be numeric or alphanumeric, I am getting suggestions about perhaps using a variable arrary from chatgpt. But for all I know this is way off base.
This is what it has come up with after a myriad of attempts:
Sub CopyAndPasteValue()
Dim sourceRange As Range
Dim targetRange As Range
Dim cell As Range
Dim value As Variant
Dim uniqueValues As New Collection
Dim uniqueValuesArray() As Variant ' declare an array variable
Dim i As Long, j As Long, k As Long
Dim sourceArray() As String ' declare sourceArray as a string array
Dim RowCount As Long ' declare RowCount as a Long variable
' Set the source range to the selected cells in the CMP update requests sheet
Set sourceRange = Selection
' If the source range is a single cell, split the cell value into an array
If sourceRange.Cells.Count = 1 Then
sourceArray = Split(sourceRange.value, ",")
RowCount = UBound(sourceArray) - LBound(sourceArray) + 1
Set sourceRange = sourceRange.Resize(RowCount, 1)
End If
' Clear contents of previous data in the index and match sheet
Sheets("index and match sheet").Range("A2:A" & Rows.Count).ClearContents
' Set the target range to cell A2 in the index and match sheet
Set targetRange = Sheets("index and match sheet").Range("A2")
' Loop through each cell in the source range
For Each cell In sourceRange
' Split the cell value by comma and loop through resulting values
If Len(cell.value) > 0 Then
For i = 0 To UBound(Split(cell.value, ","))
value = Trim(Split(cell.value, ",")(i))
' Check if value contains a dash
If InStr(value, "-") > 0 Then
' Split the value by dash
Dim rangeValues() As String
rangeValues = Split(value, "-")
If IsNumeric(rangeValues(0)) And IsNumeric(rangeValues(1)) Then
For k = CLng(rangeValues(0)) To CLng(rangeValues(1))
' Add the value to the unique values collection if it is not already present
On Error Resume Next
uniqueValues.Add CStr(k), CStr(k)
On Error GoTo 0
Next k
Else
For k = rangeValues(0) To rangeValues(1)
'likely I need this to be a variant array which is an array declared as having a variant data type'
' Add the value to the unique values collection if it is not already present
On Error Resume Next
uniqueValues.Add CStr(k), CStr(k)
On Error GoTo 0
Next k
End If
Else
' Add the value to the unique values collection if it is not already present
On Error Resume Next
uniqueValues.Add value, value
On Error GoTo 0
End If
Next i
End If
Next cell
' Convert the collection to an array
ReDim uniqueValuesArray(0 To uniqueValues.Count - 1)
For i = 1 To uniqueValues.Count
uniqueValuesArray(i - 1) = uniqueValues(i)
Next i
' Loop through uniqueValues array and paste each value to the target range in the index and match sheet
For j = 0 To UBound(uniqueValuesArray)
targetRange.value = uniqueValuesArray(j)
Set targetRange = targetRange.Offset(1, 0)
Next j
' Copy range D1:D141 to range E1:E141 using the Value property
Sheets("index and match sheet").Range("E1:E141").value = Sheets("index and match sheet").Range("D1:D141").value
End Sub
I'm new to the VBA programming language so I'm asking for some help.
I'm trying to automatize building a waterfall chart in Excel using VBA. Usually I did everything manually and it often took quite a while when data changed. So I decided to use VBA to fasten the process.
To create a waterfall chart, I need to create additional series of data. I'm trying to do it by using arrays and loops.
For one, I need to create an array which consists of absolute values of the initial array (range). But I run into an error "Subscript out of range" and can't figure out what the problem is. In Python, which I know better, I guess, there wouldn't be such a problem.
Here's my code:
Sub CreateWaterfall()
'*************************************************************************
Dim i As Integer
'*************************************************************************
' Turn a range into an array
Dim FigureArrayLength As Integer
FigureArrayLength = Range("B3", Range("B3").End(xlToRight)).Count
Dim FiguresArr() As Variant
ReDim FiguresArr(FigureArrayLength)
FiguresArr = Range("B3", Range("B3").End(xlToRight))
'*************************************************************************
' Build another array based on FiguresArr, but making all the values positive
Dim AuxiliaryFiguresArr() As Variant
ReDim AuxiliaryFiguresArr(FigureArrayLength)
For i = 1 To FigureArrayLength
AuxiliaryFiguresArr(i) = Abs(FiguresArr(i))
Next i
End Sub
What Excel doesn't like is this line, which gets highlighted in yellow when I press the 'Debug' button:
AuxiliaryFiguresArr(i) = Abs(FiguresArr(i))
What could the problem be?
Absolute Values of a Row to an Array
Sub ArrAbsRowTEST()
' Reference the worksheet ('ws').
Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
' Reference the one-row range ('rrg') (a pretty risky way).
Dim rrg As Range: Set rrg = ws.Range("B3", ws.Range("B3").End(xlToRight))
' Using the 'ArrAbsRow' function (on the range),
' write the converted values to an array ('Arr').
Dim Arr() As Variant: Arr = ArrAbsRow(rrg)
' Continue, e.g.:
Debug.Print "The array contains the following numbers:"
Debug.Print Join(Arr, vbLf)
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose: Returns the absolute values of the values from the first row
' of a range ('rrg') in a 1D one-based array.
' Remarks: It is assumed that the first row of the range
' contains numbers only.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function ArrAbsRow( _
ByVal rrg As Range) _
As Variant
' Write the values from the first row of the range
' to a 2D one-based one-row array ('rData').
Dim rData() As Variant
Dim cCount As Long
With rrg.Rows(1)
cCount = .Columns.Count
If cCount = 1 Then ' one cell
ReDim rData(1 To 1, 1 To 1): rData(1, 1) = .Value
Else ' multiple cells
rData = .Value
End If
End With
' Write the absolute values of the values from the 2D array
' to the resulting 1D one-based array ('Arr').
Dim Arr() As Variant: ReDim Arr(1 To cCount)
Dim c As Long
For c = 1 To cCount
Arr(c) = Abs(rData(1, c))
Next c
' Assign the 1D array to the result.
ArrAbsRow = Arr
End Function
I tested the below and returned to this page and then saw the solution from VBasic2008; so thought I'd add my answer too.
When I first did this, I assumed that the range derived array would be one dimensional too. I realised my mistake, when I added the array as a watch and was then able to see its dimensions.
Option Explicit
Private Sub CreateWaterfall()
'*************************************************************************
Dim i As Integer
Dim WS As Worksheet
Set WS = ThisWorkbook.Sheets("Sheet1")
'*************************************************************************
' Turn a range into an array
Dim FiguresArr As Variant
FiguresArr = WS.Range("B3", WS.Range("B3").End(xlToRight))
'*************************************************************************
' Build another array based on FiguresArr, but making all the values positive
ReDim AuxiliaryFiguresArr(0, 0) As Variant
AuxiliaryFiguresArr(0, 0) = 0
For i = 1 To UBound(FiguresArr, 2)
Call AddEntry(AuxiliaryFiguresArr, Abs(FiguresArr(1, i)))
Next i
End Sub
The procedure below is called by the code above
Public Sub AddEntry(aList As Variant, aEntry As Variant)
'
' build array for later copy onto sheet
'
Dim i%
Dim aEntry2 As Variant
If VarType(aEntry) = vbDouble Or VarType(aEntry) = vbInteger Then
aEntry2 = Array(aEntry)
Else
aEntry2 = aEntry
End If
If aList(0, 0) <> 0 Then
ReDim Preserve aList(0 To UBound(aEntry2), 0 To UBound(aList, 2) + 1)
End If
For i = 0 To UBound(aEntry2)
aList(i, UBound(aList, 2)) = aEntry2(i)
Next
End Sub
i have faced with issue while merging some dynamic ranges through VBA.
Once it is standard range like Range("A3:E4"), all is fine and i have 2 lines in values of the range.
screen from add watch
But once i want to merge different ranges like Range("A3:E3,A4:E4") i am receiving only value of the first range. Who knows how it can be fixed, and how can i correctly merge different ranges in VBA, to use their values later?
Thanks in advance
Each Range has a property named Areas which contain the sub-tables of cells.
Consider the code below
Dim r As Range
Set r = Union(Range("F2:F6"), Range("H2:H6"))
Dim a As Range
For Each a In r.Areas
Debug.Print a.Address
Next
which prints out
$F$2:$F$6
$H$2:$H$6
So each area would be used to define it own array of values
Dim a_vals as Variant, b_vals as Variant
a_vals = r.Areas(1).Value2
b_vals = r.Areas(2).Value2
I'm not an expert working with arrays, but these two methods have helped me working with ranges and merging them into 1D arrays separated by a character
Method 1: Define separate ranges and merge their content into 1D array
Public Sub MergeTwoRangesIntoArray()
' Get range 1 values into 1d array
Dim range1Values As Variant
range1Values = WorksheetFunction.Transpose(Application.Index(Range("A1:A10"), 0, 1))
' Get range 2 values into 1d array
Dim range2Values As Variant
range2Values = WorksheetFunction.Transpose(Application.Index(Range("B1:B10"), 0, 1))
' Define and redimension an array to hold the concatenated area and category values
Dim mergedRangeValues() As Variant
ReDim mergedRangeValues(1 To UBound(range1Values))
' Concatenate the area and category values and store them in an array
Dim counter As Long
For counter = 1 To UBound(range1Values)
mergedRangeValues(counter) = range1Values(counter) & "|" & range2Values(counter)
Next counter
Stop
End Sub
Method 2: Define multi area range and merge each areas' content into 1D array
Public Sub MergeTwoAreasIntoArray()
Dim multiRange As Range
Set multiRange = Range("A1:A10,B1:B10,C1:C11")
Dim totalAreas As Long
totalAreas = multiRange.Areas.Count
Dim rangeValues() As Variant
ReDim rangeValues(1 To totalAreas)
Dim areaCounter As Long
For areaCounter = 1 To totalAreas
' Get range 1 values into 1d array
rangeValues(areaCounter) = WorksheetFunction.Transpose(Application.Index(multiRange.Areas(areaCounter), 0, 1))
Next areaCounter
' Get the upper bound of the range values (first range)
Dim totalRangeValues As Long
totalRangeValues = UBound(rangeValues(1))
Dim resultArray As Variant
ReDim resultArray(1 To totalRangeValues)
Dim itemCounter As Long
For itemCounter = 1 To totalRangeValues
Dim rangeCounter As Long
For rangeCounter = 1 To totalAreas
resultArray(itemCounter) = resultArray(itemCounter) & "|" & rangeValues(rangeCounter)(itemCounter)
Next rangeCounter
Next itemCounter
End Sub
Return dynamic array from function VBA got me part of the way on this problem. I realized I should know size prior to invoking the function.
Function GetHeadersFromRange(DataRange As Range, Size As Integer) As Variant
Dim Column As Integer
Dim Headers As Variant
ReDim Headers(0 To Size)
For Column = 1 To DataRange.Columns.Count
Headers(Column) = DataRange(1, Column).Value
Next
GetHeadersFromRange = Headers
End Function
Sub TestGetHeadersFromRange()
Application.DisplayAlerts = False
Set wb = ThisWorkbook
Set TestSheet = wb.Sheets.Add()
TestSheet.Range("A1").Value = "my_header"
TestSheet.Range("A2").Value = "val"
Dim DataRange As Range: Set DataRange = TestSheet.Range("A1:A2")
Dim Size As Integer: Size = DataRange.Columns.Count
Dim Result As Variant
' Gets type mismatch
Set Result = GetHeadersFromRange(DataRange, Size)
End Sub
Not entirely sure what to do here. I need to use this function in multiple places which is why it is a function in the first place.
Edit: Clarify problem
Set Result = GetHeadersFromRange(...) gets a type mismatch.
Header Function
Improvement
Your error occurs because you are using Set (used for objects)
on an array.
A more efficient (faster) way than looping through a range is looping
through an array.
When you copy a range to a variant (possibly array), if the range
contains one cell, the variant will contain one value only. But if
the range contains multiple cells, it will be an array, whose size is
returned with UBound. Therefore there is no need for a Size argument.
IsArray is used to determine if a variant is an array. In our case we can check if the number of columns (elements) is greater than 1 instead.
Option Explicit
Function GetHeadersFromRange(DataRange As Range) As Variant
Dim vntR As Variant ' Range Variant
Dim vntH As Variant ' Header Array
Dim Noe As Long ' Number of Elements
Dim j As Long ' Range Array Column Counter,
' Header Array Element Counter
With DataRange
' Calculate Number of Elements.
Noe = .Columns.Count
' Calculate Header Range.
' Copy Header Range to Range Variant.
vntR = .Resize(1, Noe)
' Note: Range Variant (vntR) is a 2D 1-based 1-row array only if
' DataRange contains more than one column. Otherwise it is
' a variant containing one value.
End With
'' Check if Range Variant is an array.
'If IsArray(vntR) Then
' Check if Number of Elements is greater than 1.
If Noe > 1 Then
' Resize 1D 0-based Header Array to number of columns (2) in Range
' Array minus 1 (0-based).
ReDim vntH(Noe - 1)
' Loop through columns of Range Array.
For j = 1 To Noe
' Write value at first row (1) and current column (j) of Range
' Array to current element (j-1) of Header Array.
vntH(j - 1) = vntR(1, j)
Next
Else
' Resize 1D 0-based Header Array to one element only (0).
ReDim vntH(0)
' Write Range Variant value to only element of Header Array.
vntH(0) = vntR
End If
GetHeadersFromRange = vntH
End Function
Sub TestGetHeadersFromRange()
Dim TestSheet As Worksheet ' Source Worksheet
Dim DataRange As Range ' Data Range
Dim Result As Variant ' Result Variant (possibly Array)
Dim i As Long ' Result Array Element Counter
' Add a new worksheet (Source Worksheet).
' Create a reference to the newly added Source Worksheet.
Set TestSheet = ThisWorkbook.Sheets.Add()
' In Source Worksheet
With TestSheet
' Add some values.
.Range("A1").Value = "my_header"
.Range("A2").Value = "val"
.Range("B1").Value = "my_header2"
.Range("B2").Value = "val2"
End With
' Test 1:
Debug.Print "Test1:"
' Create a reference to DataRange.
Set DataRange = TestSheet.Range("A1:A2")
' Write Data Range to 1D 0-based Result Array.
Result = GetHeadersFromRange(DataRange)
' Loop through elements of Result Array.
For i = 0 To UBound(Result)
' Write current element of Result Array to Immediate window.
Debug.Print Result(i)
Next
' Test 2:
Debug.Print "Test2:"
' Create a reference to DataRange.
Set DataRange = TestSheet.Range("A1:B2")
' Write Data Range to 1D 0-based Result Variant.
Result = GetHeadersFromRange(DataRange)
' Loop through elements of Result Array.
For i = 0 To UBound(Result)
' Write current element of Result Array to Immediate window.
Debug.Print Result(i)
Next
End Sub
Is there a way to store specific cells into new variables from a range in VBA? What I mean is...
Suppose I have set the data below to a range call "numbers".
Now in VBA, for each row I want to extract each individual cell value and assign each value to a different variable. And then repeat again for the next row.
I essentially want to the use the values in a given row to do something and then have it repeat again for the next row.
Does this make sense???
This is what I've been playing around with... but I don't get how to assign each cell from a given row to a new variable
Public Sub try()
Dim rng As Range
Dim row As Range
Dim cell As Range
Dim n As Double
Set rng = Range("numbers")
For Each row In rng.Rows
For Each cell In row.Cells
n = cell.value
Next cell
Next row
End Sub
Try this:
Dim numberArray As Variant
' this line will assign numbers inside the range to an array
numberArray = Range("numbers").Value2
' now you are able to access all numbers in you range through this array, like this:
MsgBox numberArray(1, 1) 'it will show 1
The way you are doing it right now doesn't make sense, since you are assigning all values to one variable n, so on every iteration of a loop previous value gets overwritten, resulting in n having last value in a range, which is 3.
Is there any particular reason you want to store any cell value in a new variable?
With a given range it would be very easy to just store your values in a Variant Array. In your example it would be something like:
Public Sub try()
Dim rng As Range
Dim dataArray as Variant
Set rng = Range("numbers")
dataArray = rng
debug.print dataArray(1, 2) 'This would print 7 in your example range
end sub
You could then easily loop through your Variant Array like this:
Dim i as Long, j as Long
For i = 1 To UBound(dataArray, 1) 'This will loop through each row
For j = 1 To UBound(dataArray, 2) 'This will loop through each column (cell in your row)
Debug.Print dataArray(i, j)
Next
Next
UBound() returns the length of the Array at the given dimension as the second parameter. I am just printing the values again since I do not know what exactly your intention is.