I am getting an error of "Subscript out of Range" when I'm trying to add the row value, of visible cells (minus the header) to the array. Below the code:
Dim Rng As Range
Dim r As Range
Dim i as Long
Dim arr() As Long
Set Rng = ActiveSheet.UsedRange.Resize(ActiveSheet.UsedRange.Rows.Count - 1, ActiveSheet.UsedRange.Columns.Count).Offset(1, 0).SpecialCells(xlCellTypeVisible)
i = 0
For Each r In Rng.Rows
'Debug.Print r.Row
arr(i) = r.Row
i = i + 1
Next
Am I forgetting something ?! I'm still new to VBA and more so, to arrays.
This function works fine...
I didn't get how you are calculating the range... but this output is coming out of the range only.. array is totally dynamic
Sub foo()
Dim Rng As Range
Dim r As Range
Dim i As Long
Dim arr() As Variant
Set Rng = ActiveSheet.UsedRange.Resize(ActiveSheet.UsedRange.Rows.Count - 1, ActiveSheet.UsedRange.Columns.Count).Offset(1, 0).SpecialCells(xlCellTypeVisible)
i = 1
For Each r In Rng.Rows
ReDim Preserve arr(i)
arr(i) = r.Row
Debug.Print arr(i)
i = i + 1
Next
End Sub
As already pointed out, you have to define the array. You can give it a fixed size when defining it (Dim arr(2) as Integer).
Dynamic ranges can be made with using ReDim. With Preserve it saves the values in the array when redefining the size. (Note: You can only ReDim the last dimension of an array)
The problem is that although you are declaring the array, you haven't initialised it with a size, so there are no elements in the array hence the subscript out of range.
Your code should read, note the other problem you will have is how you are trying to address the range, I have corrected below:
Dim Rng As Range, r As Range
Dim i as integer
Dim ary() as Long
Set Rng = ActiveSheet.UsedRange.Resize(ActiveSheet.UsedRange.Rows.Count - 1, ActiveSheet.UsedRange.Columns.Count).Offset(1, 0).SpecialCells(xlCellTypeVisible)
Redim ary(Rng.Rows.Count)
i = 0
For Each r In Rng.Rows
'Debug.Print r.Row
arr(i) = CLng(r.Row)
i = i + 1
Next
This is a tested and working example
Related
I want to store a range of variable size in an one-dimensional array. The range starts at A2 and goes to the last row of the same column. My approach looks like that. It's flawed.
Option Explicit
Sub Range_to_Array()
Dim i, j, k As Integer
Dim arr1(), arr2(), arr3(), arr4() As Variant
With Worksheets("table1")
arr1() = .Cells(.Range("A2"), .Range("A1").End(xlDown).Row)
End With
End Sub
Please, try the next way. Application.Transpose transforms a 2D array with a column in a 1D type. No iteration needed:
Sub Array1DFromColumnRange()
Dim ws As Worksheet, lastR As Long, arr
Set ws = Worksheets("table1")
lastR = ws.Range("A" & ws.rows.count).End(xlUp).Row
arr = Application.Transpose(ws.Range("A2:A" & lastR).Value)
Debug.Print Join(arr, "|") 'just to visually see the result in Immediate Window (Ctrl + G)...
End Sub
The returned 1D array is 1 based, as the 2D array directly extracted from a range. To transform it in zero based type, can be done without iteration, too:
'change the array type to be zero based:
ReDim Preserve arr(0 To UBound(arr) - 1)
Debug.Print LBound(arr)
Debug.Print Join(arr, "|")
Your problem is that your Range-Definition is wrong.
Cells expect 2 parameters (row and column) to address one cell. This is not what you want, and even if, your parameters would be wrong.
What you need in your case is Range.
Now Range can be called either with one or two parameters.
If you call it with one parameter, this defines the whole range.
Examples: Range("A1") or Range("B2:C5") or Range("B:B")
Whats often used in VBA is something like Range("A1:A" & lastRow)
If you call it with two parameters, those two parameters define the first and last cell of the range.
Examples: Range(Range("A1"), Range("C10")) or Range(Cells(1, 1), Cells(10, 3))
I would advice to define an intermediate variable to save the Range - makes it much easier to debug. Also the row number of the last cell should go into an intermediate variable.
In your case you could use one of the following
Dim r As Range, lastRow As Long
' Get the last row in use (usually its better to go up from the end of the sheet)
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
' 2 parameters
Set r = .Range(.Cells(2, 1), .Cells(2, lastRow))
' 1 Parameter, last row is concatenated to the range definition
Set r = .Range("A2:A" & lastRow)
' Use Resize
Set r = .Range("A2").Resize(lastRow-1, 1) ' -1 because you start at row 2
arr1 = r.Value
Try this instead.
Sub Range_to_Array()
Dim i As Integer, j As Integer, k As Integer
Dim arr1() As Variant, arr2() As Variant, arr3() As Variant, arr4() As Variant
Dim myRange As Range
With Worksheets("table1")
arr1 = .Range(.Range("A2"), .Range("A1").End(xlDown)).Value
End With
Debug.Print arr1(1, 1)
End Sub
Also please note that in order to properly declare variables, you need to specify data type for each variable separately.
Dim i, j, k As Integer
actually means
Dim i As Variant, j As Variant, k As Integer
I have the following code:
Dim lRow As Long
Dim c As Variant
lRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
c = Application.Transpose(ws.Range("A2:A" & lRow).Value2)
As long as lRow is > 2 then c becomes a Variant/Variant(1 to x) i.e. an array of Variant/String with values from column A - this is what I need!
However, sometimes the lRow is 2 - this means that c becomes just a string (instead of an array with one entry) - this messes up code further down the sub.
Is there a way I can use Application.Transpose(ws.Range("A2:A" & lRow).Value2) to produce an actual array instead of a Variant? Or somehow force c to always be the array?
Or do I just need to do if checks on the type and build more logic into the whole thing?
I tried Dim c() As String but that's not what Transpose produces...
You should read the range first into a Range variable and then transpose only if it has at least 2 cells:
Dim lRow As Long
Dim c() As Variant
Dim rng As Range
lRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
Set rng = ws.Range("A2:A" & lRow)
If rng.Count > 1 Then
c = Application.Transpose(rng.Value2)
Else
ReDim c(1 To 1, 1 To 1)
c(1, 1) = rng.Value2
End If
Alternatively, you could use a separate function to get the values from a range into an array:
Private Function RangeToArray(ByVal rng As Range) As Variant()
If rng Is Nothing Then Err.Raise 91, "RangeToArray", "Range not set"
If rng.Areas.Count > 1 Then Err.Raise 5, "RangeToArray", "Multi-area range"
If rng.Count > 1 Then
RangeToArray = rng.Value2
Else
Dim arr(1 To 1, 1 To 1) As Variant
arr(1, 1) = rng.Value2
RangeToArray = arr
End If
End Function
But note that when applying Transpose to a 2-dimensional array of 1 value it actually converts it to a 1-dimensional array:
Dim lRow As Long
Dim c() As Variant
lRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
c = Application.Transpose(RangeToArray(ws.Range("A2:A" & lRow))) 'c is 1-D if range has only 1 cell
So, the first choice is probably better.
Finally, you could use your own version of Transpose. See my array repository
EDIT 1
Use the following method if you only need 1D Arrays. It works with rows and columns.
Private Function OneDRangeTo1DArray(ByVal rng As Range) As Variant()
Const methodName As String = "OneDRangeTo1DArray"
If rng Is Nothing Then
Err.Raise 91, methodName, "Range not set"
ElseIf rng.Areas.Count > 1 Then
Err.Raise 5, methodName, "Multi-area range"
ElseIf rng.Rows.Count > 1 And rng.Columns.Count > 1 Then
Err.Raise 5, methodName, "Expected 1-row or 1-column range"
End If
Dim arr() As Variant
If rng.Count = 1 Then
ReDim arr(1 To 1)
arr(1) = rng.Value2
Else
Dim v As Variant
Dim i As Long
ReDim arr(1 To rng.Count)
i = 0
For Each v In rng.Value2
i = i + 1
arr(i) = v
Next v
End If
OneDRangeTo1DArray = arr
End Function
another possibilty
c = Application.Index(ws.Range("A2:A" & lRow).Value2, Application.Evaluate("transpose(row(1:" & lRow - 1 & "))"), 1)
A Variant IS a TYPE (similar to String, Long, Integer, Byte, Double). However, I am guessing you are trying to force a VARIABLE to be a DIFFERENT type (string?) and as part of an ARRAY?
If so, I think this should work for you. It creates an array starting at 0 with a maximum of the last row less two cells. If you wanted to transpose it, or make it multidimensional, just add another layer.
lRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
ReDim c(lRow - 2) As String
'if you need two dimensioanl you could experiment with this:
'ReDim c(lRow - 2, 0) As String
Dim i As Long
For i = 0 To (lRow - 2)
c(i) = ws.Range("A2").Offset(i, 0).Value2
'OR if two dimenssional
'C(i,0) =
Next i
Because I was only after a 1D array, I ended up just creating a function to reuse based on Christian Buse's answer:
Public Function GetArrayFromVerticalRange(rng As Range) As Variant
If rng.Count > 1 Then
GetArrayFromVerticalRange = Application.Transpose(rng.Value2)
Else
Dim c(0) As Variant: c(0) = rng.Value2
GetArrayFromVerticalRange = c
End If
End Function
Used "Vertical" term to remind me to only pass in single column ranges! And could create a "Horizontal" version to use the transpose of the transpose
Recently I was wondering about the possibility of speeding up the program by switching a part of the code below:
Dim cell as Variant
Dim myValues() as Double
ReDim myValues(myRange.Count - 1)
Dim i as Integer: i = 0
For Each cell in myRange.Cells
myValue(i) = cell.Value
i = i + 1
Next cell
into a loop where I could refer to the value of each cell directly, instead of instantiating a cell object, assigning it a cell value from a given range, and then extracting the cell value.
In my mind, the pseudocode would look something like this:
Dim cellValue as Double
Dim myValues() as Double
ReDim myValues(myRange.Count - 1)
Dim i as Integer: i = 0
For each cellValue in myRange.Cells.Values
myValues(i) = cellValue
i = i + 1
Next cellValue
If my overall concept is wrong from the start, or if you can't get the cells values from Range faster, then there was no question.
Due to the fact that this is my first post, I could have written something incorrectly / in wrong posting convention. Let me know and I'll fix it.
Cheers
As #SJR notes, this is a common way to access data from a range without going cell-by-cell
Dim arr, i as long, rng As Range
Set rng = Activesheet.Range("A1:B20")
arr = rng.Value 'arr is now a 2D array (1 To 20, 1 To 2)
'Note: base is 1 and not the more-typical 0
For i = 1 to ubound(arr,1)
Debug.Print arr(i, 1), arr(i, 2)
Next i
arr(3, 2) = 999
rng.value = arr 'put the data back to the range
If the reason is for getting rid of the 2D array a function like this can be the solution:
Function VectorFromRange(rng As Range) As Variant
Dim arrIn As Variant
arr = rng.value 'Dumping the data from range
Dim i As Long
Dim item As Variant
ReDim arrOut(1 To rng.Cells.Count) As Variant
For Each item In arr
i = i + 1
arrOut(i) = item
Next item
VectorFromRange = arrOut
End Function
I have this sample table.
What I am trying to do is to get all the cell values in all colored cells and transpose them to another worksheet.
I have trouble with the code below to add and set those ranges together so that I can transpose all of them in a ROW in the other worksheet. I have started with the code below
Sub AddRanges()
Dim inRange As Range, inRangeValues() As Variant, outRangeValues() As Variant
Dim finalRow As Long
Dim inRange As Range
Set inRange = Sheet1.Range("A1:A6", "C1:C6", C10:C14) 'I think i got this wrong; Error Type Mismatch
inRangeValues() = inRange.Value 'generate 2d array
outRangeValues = Application.Transpose(inRangeValues)
With Sheet2
finalRow = .Cells(Rows.Count, 1).End(xlUp).Row 'find last row
If inRange.Columns.Count > 1 Then '2d array for output
.Cells(finalRow + 1, 1).Resize(UBound(outRangeValues, 1), UBound(outRangeValues, 2)) = outRangeValues 'Resize according to output array dimensions
Else '1D array for output
.Cells(finalRow + 1, 1).Resize(1, UBound(outRangeValues, 1)) = outRangeValues
End If
End With
End sub
In this example, what is the best approach to combine these ranges so I can transpose them as a ROW? Thanks.
Your code has major problems due to:
Double declaration of inRange
Wrong syntax for Set inRange the entire address needs to be enclosed in a single pair of quotes
Try Set inRange = Range("a1:a6, c1:c6, c10:c14")
Wrong method of reading into an array
When you have a range that consists of multiple areas, you have to convert each area separately.
Then you can create a 1-D array from this depending on the order you wish to have these elements, and write it wherever you want.
For example:
Option Explicit
Sub test()
Dim inRange As Range, inRangeValues As Variant, outRangeValues As Variant
Dim finalRow As Long
Dim I As Long, J As Long, V As Variant, L As Long
Dim lCols As Long
Set inRange = Range("a1:a6, c1:c6, c10:c14")
ReDim inRangeValues(1 To inRange.Areas.Count)
For I = 1 To inRange.Areas.Count
inRangeValues(I) = inRange.Areas(I)
Next I
'how many columns?
lCols = 0
For I = 1 To UBound(inRangeValues, 1)
lCols = lCols + UBound(inRangeValues(I), 1)
Next I
ReDim outRangeValues(1 To lCols)
L = 0
For I = 1 To UBound(inRangeValues, 1)
For J = 1 To UBound(inRangeValues(I), 1)
L = L + 1
outRangeValues(L) = inRangeValues(I)(J, 1)
Next J
Next I
Stop
' enter some code to write the results where you want
' below is just throwaway for proof of concept
Range("f20").Resize(columnsize:=UBound(outRangeValues)).Value = outRangeValues
End Sub
Given your input, the above code would create output like:
You are correct that your code is wrong where you highlight. Try a union. From there, it should be pretty basic to just loop through your range and put them wherever you want in the Sheet2 spreadsheet. See if the below does what you need.
Sub AddRanges()
Dim inRange As Range, acell As Range, aCounter As Long
Const startAddress As String = "A1"
Set inRange = Union(Sheet1.Range("A1:A6"), Sheet1.Range("C1:C6"), Sheet1.Range("C10:C14"))
For Each acell In inRange.Cells
If Not IsEmpty(acell) Then
finalRow = sheet2.Cells(Rows.Count, 1).End(xlUp).Row + 1 'find last row
sheet2.Cells(finalRow, 1).Value = acell.Value
End If
Next acell
End Sub
Check it out.
Sub RngAreaTransps()
Dim RangeArea As Range, LstRw As Long
Dim sh As Worksheet, ws As Worksheet
Dim col As Long, InRange As Range
Set sh = Sheets(1)
Set ws = Sheets(2)
LstRw = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row + 1
With sh
Set InRange = .Range("A1:A6, C1:C6, C10:C14")
For Each RangeArea In InRange.Areas
With ws
col = .Cells(LstRw, .Columns.Count).End(xlToLeft).Column
If col <> 1 Then col = col + 1
RangeArea.SpecialCells(xlCellTypeConstants).Copy
.Cells(LstRw, col).PasteSpecial Transpose:=True
End With
Next RangeArea
End With
Application.CutCopyMode = False
End Sub
I have an Excel-worksheet with different "sections" separated by an empty row. What I want to do is to simple get the row numbers to work with them. Sadly the code is not executing the For-Loop (No failure, just not entering it) but the rowNumber variable is set properly. Did I miss something on the For-Loop?
Sub Foo()
Dim currentSheet As Worksheet
Set currentSheet = activeSheet
emptyRows = FindAllEmptyRows(currentSheet)
End Sub
Function FindAllEmptyRows(sheet As Worksheet) As Variant
Dim emptyRows() As Variant
Dim i As Long, rowNumber As Long
Dim rowCounter As Integer
rowCounter = 1
rowNumber = sheet.UsedRange.Rows.Count
For i = rowNumber To 1
If Cells(i, 1).End(xlToRight).Column = 16384 And Cells(i, 1) = "" Then
emptyRows(rowCounter) = i
rowCounter = rowCounter + 1
End If
Next
FindAllEmptyRows = emptyRows
End Function
If you want to iterate from last row to first you will need to add Step -1.
emptyRows() needs to be sized to fit the data using ReDim
.Column = 16384 should be changed to .Column = sheet.Columns.Count.
I prefer If WorksheetFunction.CountA(sheet.Rows(i)) = 0 Then
Cells needs to be qualified to sheet: sheet.Cells(i, 1)
Refactored Code
Function FindAllEmptyRows(sheet As Worksheet) As Variant
Dim emptyRows() As Variant
Dim i As Long, rowNumber As Long
Dim rowCounter As Integer
rowNumber = sheet.UsedRange.Rows.Count
For i = rowNumber To 1 Step -1
If sheet.Cells(i, 1).End(xlToRight).Column = sheet.Columns.Count And Cells(i, 1) = "" Then
If rowCounter = 0 Then
ReDim emptyRows(0)
Else
ReDim Preserve emptyRows(rowCounter)
End If
emptyRows(rowCounter) = i
rowCounter = rowCounter + 1
End If
Next
FindAllEmptyRows = emptyRows
End Function
SpecialCells
Range.SpecialCells() can be used to divide a Range into areas of cells that meet certain criteria.
MSDN - Range.SpecialCells Method (Excel)
Returns a Range object that represents all the cells that match the specified type and value
OZ Grid
One of the most beneficial Methods in Excel (in my experience) is the SpecialCells Method. When used, it returns a Range Object that represents only those type of cells we specify. For example, one can use the SpecialCells Method to return a Range Object that only contains formulae. In fact, we can, if we wish, even narrow it down further to have our Range Object (containing only formulae) to return only formulae with errors.
Examining the output of this code should give you a good ideas of how to use SpecialCells.
Sub SpecialFoo()
Dim rArea As Range, rBlanks As Range, rFormulas As Range, rConstants As Range, rUnion As Range
Dim sheet As Worksheet
Set sheet = ActiveSheet
On Error Resume Next
Set rBlanks = sheet.UsedRange.SpecialCells(xlCellTypeBlanks)
On Error GoTo 0
If Not rBlanks Is Nothing Then
For Each rArea In rBlanks.Areas
Debug.Print "rBlanks Areas: "; rArea.Address
Next
End If
On Error Resume Next
Set rFormulas = sheet.UsedRange.SpecialCells(xlCellTypeFormulas)
On Error GoTo 0
If Not rFormulas Is Nothing Then
For Each rArea In rFormulas.Areas
Debug.Print "rFormulas Areas: "; rArea.Address
Next
End If
On Error Resume Next
Set rConstants = sheet.UsedRange.SpecialCells(xlCellTypeConstants)
On Error GoTo 0
If Not rConstants Is Nothing Then
For Each rArea In rConstants.Areas
Debug.Print "rConstants Areas: "; rArea.Address
Next
End If
If Not rFormulas Is Nothing And Not rConstants Is Nothing Then
Set rFormulas = Union(rConstants, rFormulas)
For Each rArea In rFormulas.Areas
Debug.Print "rUnion Areas: "; rArea.Address
Next
End If
End Sub
you have to size emptyRows() before using it
furthermore you could use WorksheetFunction.Count() to check for any value in current row
finally
Function FindAllEmptyRows(sheet As Worksheet) As Variant
Dim emptyRows() As Variant
Dim i As Long, rowNumber As Long, rowCounter As Long
With sheet.UsedRange ' reference passed sheet UsedRange
rowNumber = .Rows.Count
ReDim emptyRows(0 To rowNumber - 1) ' dim the array to the maximum possible size
For i = rowNumber To 1 Step -1 ' step through reference range rows from the last baxkwards to the first
If WorksheetFunction.Count(.Rows(i)) = 0 Then
emptyRows(rowCounter) = i + .Rows(1).Row - 1 ' fill array in current index with current row index
rowCounter = rowCounter + 1 ' update array index
End If
Next
End With
ReDim Preserve emptyRows(0 To rowCounter) ' redim the array according to the actual number of found empty rows
FindAllEmptyRows = emptyRows
End Function
please note that:
emptyRows(rowCounter) = i + .Rows(1).Row - 1
is storing the absolute row index, i.e. the sheet row index, while
emptyRows(rowCounter) = i
would store the relative row index, i.e. the row index withing the UsedRange, which may start from a row different than row 1