I try to write strings into a list
Sub test()
Dim x() As String
For j = 1 To 5
x(j) = "Number" & j
Next j
End Sub
and get the message "Subscript out of Range". Can anyone tell me what is wrong with the snippet and how I can solve it?
You have to ReDim your Array.
With your Code your Array has no Length defined, thats why you get the Error message Subscript out of Range
If you know the exact length before you have to define your array like this:
Dim x(5) As String
If you want this to stay dynamic, try the following Code, every iteration we make your Array one step bigger
Sub test()
Dim x() As String
Dim j As Integer
For j = 1 To 5
ReDim x(j) //Here change the Length of the Array
x(j) = "Number" & j
Next j
End Sub
Related
I have written a function that checks cell to be crossed out:
Function isCrossedout(myRange As Range)
isCrossedout = myRange.Font.Strikethrough
End Function
and I have a column "A:A" of numbers where I want to sum up crossed out elements only.
Can I insert in any cell the standard function SUMIFS with my user defined function?
When I try this:
someCell.FormulaR1C1 = "=SUMIFS('Page'!RC1:RC1, isCrossedout)"
it returns zero value when the formula applied.
I realize there is a way to use summing such cells in a pure VBA way with a loop, but I want to try to use it with Excel SUMIFS formula.
First, you need isCrossedout to return a boolean array. Font.Strikethrough will not return an array, so use a loop:
Function isCrossedout(ByVal myRange As Range) As Boolean()
Dim arr() As Boolean
ReDim arr(1 To myRange.Rows.Count, 1) ' assumes myRange has one column
Dim cell As Range
For Each cell In myRange
Dim counter As Long
counter = counter + 1
arr(counter, 1) = cell.Font.Strikethrough
Next
isCrossedout = arr
End Function
Next, I'd use SUMPRODUCT, with the double unary -- to coerce the boolean array to an array of ones and zeros.
=SUMPRODUCT(A2:A5*--isCrossedout(A2:A5))
For a version that can handle a multi-column input:
Function isCrossedout(myRange As Range) As Boolean()
Dim arr() As Boolean
ReDim arr(1 To myRange.Rows.Count, 1 To myRange.Columns.Count)
Dim i As Long, j As Long
For i = 1 To myRange.Rows.Count
For j = 1 To myRange.Columns.Count
arr(i, j) = myRange.Cells(i, j).Font.Strikethrough
Next
Next
isCrossedout = arr
End Function
I've done quite a bit of searching and can't find any code that matches my situation or to a point I can modify except for one.
Looking at the spreadsheet below. I want to have the user enter the OrderNumber then search Column A for every value of that number. As it does I want it to copy the ItemNumber and QtyOrdered to two different variables in order to put them into textboxes later on.
I want it to "stack" the information into the variable so something like ItemNumValues = ItemNumValues + Cell.Value
I tried to modify code from someone else ("their code") but I am getting a mismatch type error. The rest of the code works. There are some trace elements in the script from previous features that aren't used and I just haven't removed them yet.
'***********************************************************
'********** Their Code Follows *****************
'***********************************************************
Dim numentries As Integer
Dim i As Integer
'***********************************************************
'Get number of entries
numentries = Worksheets(Sheet1).UsedRange.Rows.Count
'*************************************************************
'Run loop to cycle through all entries (rows) to copy
For i = 1 To numentries
If (Worksheets("Sheet1").Cells(i + 2, 1).Value = InStr(1, Cell, OrderNumber, vbTextCompare)) Then
MsgBox Test
End If
Next i
End If
'***********************************************************
'********** End Their Code *****************
'***********************************************************
I recommend using a multidimensional array. If you've never used arrays before, I strongly suggest reading up on them.
Sub GatherData()
Dim c As Range
Dim aGetData() As Variant 'This is our array
Dim i As Integer
Dim a As Integer
Dim iRowCount As Integer
Dim sRange As String
'Gather data
iRowCount = Worksheets("Sheet1").UsedRange.Rows.Count
For Each c In Range("A2:A" & iRowCount)
If c.Value = 636779 Then
ReDim Preserve aGetData(2, i) 'An array must have a set size but as we
'do not know how many order numbers will be found we have to 'resize'
'the array to account for how many we do find. Using "ReDim Preserve"
'keeps any data we have placed into the array while at the same time
'changing it's size.
For a = 0 To 2 'Our first index will hold each col of data that is why
'it is set to 2 (arrays start at a base of zero, so
'0,1,2 will be each col(A,B,C)
aGetData(a, i) = c.Offset(0, a) 'This gets each value from col A,B and C
Next a
i = i + 1 'Increment for array in case we find another order number
'Our second index "aGetData(index1,index2) is being resized
'this represents each order number found on the sheet
End If
Next c
'How to read the array
For i = 0 To UBound(aGetData())
For a = 0 To 2
Debug.Print aGetData(a, i)
Next a
Next i
End Sub
It seems that the OrderNumber (column A) is sorted. Very good news (if they're not, just sort them ;) ). This simple function will get you the ItemNumbers and QtyOrdered into a bi-dimensional array, where each row is a pair of them.
Function ArrItemQty(ByVal OrderNumber As Long)
With Worksheets("Sheet1").UsedRange.Offset(1)
.AutoFilter 1, OrderNumber
ArrItemQty= .Resize(, 2).Offset(, 1).SpecialCells(xlCellTypeVisible).value
.Parent.AutoFilterMode = False
End With
End Function
And here's a little testing:
Sub Test()
Dim i As Long, j As Long, ar
ar = ArrItemQty(636779)
For i = LBound(ar, 1) To UBound(ar, 1)
Debug.Print
For j = LBound(ar, 2) To UBound(ar, 2): Debug.Print ar(i, j),: Next
Next
End Sub
p.s. be aware that the resulting array is 1-based. Use LBound and UBound as indicated is safest.
I'm trying to return all rows of data of an unknown amount [8 rows] from two columns. I get the subscript out of range error for >> SERnumber(rws, clm).
I'm simply trying to return:
in AAA
out AAA
in AAA
in VVV
in GGG
Here's my non-working code:
Sub Button1_Click()
Dim SERnumber() As String
Dim i As Integer
Dim strMessage As String
Dim rws As Integer
Dim clm As Integer
' assign variable > rws the # of rows containing data
rws = Cells(Rows.Count, 2).End(xlUp).Row
' Redimension the SERnumber array variable >>
' for n? rows and 2 columns
ReDim SERnumber(1 To rws, clm)
For i = 1 To rws
For clm = 1 To 2
SERnumber(rws, clm) = Cells(rws, clm).Value
Next clm
Next i
' Loop through the array and add the names to a string
strMessage = "Here are the results:" & vbCrLf
For i = 0 To rws
strMessage = strMessage & SERnumber(i) & vbCrLf
Next 'i
MsgBox strMessage
End Sub
You can assign Excel Range to VBA Array object as shown in the following VBA code example (Range includes entire columns A and B):
Sub Range2Array()
Dim arr As Variant
arr = Range("A:B").Value
'alternatively
'arr = Range("A:B")
'test
Debug.Print (arr(1, 1))
End Sub
Such direct assignment to 2d-array has tremendous performance advantage vs using the Range iteration. You can then perform all necessary operations on array elements instead of range cells (it also will be really fast in comparison to iterative range ops).
Another useful technique is to assign Excel's UsedRange to VBA Array:
arr = ActiveSheet.UsedRange
And, the most trivial example (pertinent to your case of 2 columns, 8 rows):
arr = Range("A1:B8").Value
Hope this will help. Best regards,
I'm having a problem defining a range on a separate sheet for an array that I have for a function that I'm running. The function is KVLOOKUP and can be found here. The problem I'm having is when I try to set the Range in Sub Searched it won't accept any type of defined range. I've tried what I can think of to define the range in different ways. Not sure where I'm going wrong here.
Function to be Called
Function KVLOOKUP(LookedValue As String, Matrix As Variant, Column As Integer) As Variant
Dim Result() As Variant
Dim i As Integer
Dim Counter As Long
Dim Column1 As Integer
Column1 = Column + 1
If IsObject(Matrix) Then Matrix = Matrix.Value
On Error Resume Next
Do
i = i + 1
Counter = UBound(Matrix, i)
Loop Until Err.Number <> 0
If Counter < Column Then KVLOOKUP = CVErr(xlErrNum): Exit Function
Counter = 0
For i = LBound(Matrix, 1) To UBound(Matrix, 1)
If Matrix(i, 1) = LookedValue Then
Counter = Counter + 1
ReDim Preserve Result(1 To Counter)
Result(Counter) = Matrix(i, Column) & " - " & Matrix(i, Column1)
End If
Next i
On Error GoTo 0
If Counter = 0 Then
KVLOOKUP = CVErr(xlErrNA)
Else
KVLOOKUP = Result(1)
For i = 2 To UBound(Result)
KVLOOKUP = KVLOOKUP & ", " & Result(i)
Next i
End If
End Function
My problem is within the code below. In a cell I can call KVLOOKUP like a normal function =KVLOOKUP(TextToSearch,'IDBHour1'!B2:E120,2). When I have attempted to define the same range by calling the function within VBA I haven't been able to define the same range as above.
Sub to define E_name and Rnge Values
For some reason if I try to define the range like this (which is how it would be done for a normal VLookup function) it doesn't provide any results. This is how I've been going about debugging my issue.
When I run the code I get an "Object variable or With Block variable not set" error
Sub SearcherBox()
'E_name is just a name i.e., John Doe
'Rnge is the range in which KVLOOKUP is searching for "John Doe"
Dim Rnge as Range
Rnge = Sheets("IDBHour1").Range("B2:E120")
Sal = Application.WorksheetFunction.KVLOOKUP(E_name, Rnge, 2)
MsgBox Sal
End Sub
A few things:
Rnge is an object variable. Object variables require using the Set keyword on assignment, so
SET Rnge = Sheets("IDBHour1").Range("B2:E120")
Further, your UDF KVLOOKUP is not a WorksheetFunction and therefore not a member of the WOrksheetFunction class, so you get an error on the next line, too. Call your UDF simply as:
Sal = KVLOOKUP(E_name, Rnge, 2)
One of the most powerful things about VB is ability to loop through objects in a collection WITHOUT referring to the index - for each loop.
I find it very useful only want to remove objects from a collection.
When doing removing objects from a predefined such as rows on a spread sheet the code is simpler if I use indexing and start at the largest and work back to the first. (Step -1 with an iterator) (otherwise requires an offset as the For each moves the enumerator pointer back to the previous object once the active one is deleted)
eg.
For intA = 10 to 1 step -1
' ...
Next
What about when using a For Each | Next
eg.
For each rngCell in Selection.Cells
' ...
Next
How could I loop backwards using the for each loop syntax?
It's not possible to loop backwards using the for each loop syntax.
As an alternative you can use a For i = a To 1 Step -1 loop:
Sub reverseForEach()
Dim i As Long, rng As Range
Set rng = ActiveSheet.Range("A1:B2")
For i = rng.Cells.Count To 1 Step -1
Debug.Print rng.item(i).Address
' Or shorthand rng(i) as the Item property
' is the default property for the Range object.
' Prints: $B$2, $A$2, $B$1, $A$1
Next i
End Sub
This works with all collections that have the Item property. For instance Worksheets, Areas or Shapes.
Note: The order of the loop when using on the Range object is from right to left, then up.
For built in collections (eg a Range) the short answer is: you can't. For user defined collections the answer linked by #VBlades might be useful, although the cost might outweigh the benifit.
One work around is to seperate the identification of items to be removed from the actual removal. Eg, for a range, build up a new range variable using Union, then process that variable, eg delete all the rows in one go. For the Range example, you can also take advantage of the Variant Array method to further speed things up.
Whether or not any of this is useful will depend on your actual use case.
There are other good answers but here's another alternative method of "stepping backwards" through a Range.
Function to Invert Range into Array
This function returns a "backwards Range Array" that can be used with For..Each:
Function ReverseRange(rg As Range) As Range()
Dim arr() As Range, r As Long, c As Long, n As Long
With rg
ReDim arr(1 To .Cells.Count) 'resize Range Array
For r = .Cells(.Rows.Count, 1).Row To .Cells(1, 1).Row Step -1
For c = .Cells(1, .Columns.Count).Column To .Cells(1, 1).Column Step -1
n = n + 1
Set arr(n) = .Worksheet.Cells(r, c) 'set cell in Array
Next c
Next r
End With
ReverseRange = arr 'return Range Array as function result
End Function
Example Usage:
Sub test()
Dim oCell
For Each oCell In ReverseRange(ActiveSheet.Range("E5:A1"))
Debug.Print oCell.Address 'do something here with each cell
Next oCell
End Sub
use a second variable that is set as your wanted counter and use this one in your code
'ex: Loop from n = 19 to 16
For i = 0 To 3
n = 19 - i
'your code here using n as the counter
Next
Only for Range collections. They are more complicated if they have more than 1 Area.
Basically there are two loops, the first one keeps the index of all the cells in an array and the second one creates a union of ranges from back to front
Option Explicit
Private Sub Main()
Dim InvertedRange As Range
Set InvertedRange = InvertRange(Application.Union(ActiveSheet.Range("A1:A2"), _
ActiveSheet.Range("F6:F7"), ActiveSheet.Range("E4:F5"), ActiveSheet.Range("E1")))
Dim ActualRange As Range
For Each ActualRange In InvertedRange
Debug.Print (ActualRange.Address(False, False) & " : " & ActualRange.Value)
Next ActualRange
End Sub
Public Function InvertRange(ByVal rngRange_I As Range) As Range
Dim RangesArray() As Long
ReDim RangesArray(1 To rngRange_I.Count, 1 To rngRange_I.Count)
Dim ActualArea As Range
Dim ActualRange As Range
Dim ArrayIndex As Long
For Each ActualArea In rngRange_I.Areas
For Each ActualRange In ActualArea
ArrayIndex = ArrayIndex + 1
RangesArray(ArrayIndex, 1) = ActualRange.Row
RangesArray(ArrayIndex, 2) = ActualRange.Column
Next ActualRange
Next ActualArea
Dim ActualRow As Long
Dim ActualColumn As Long
ActualRow = RangesArray(UBound(RangesArray, 1), 1)
ActualColumn = RangesArray(UBound(RangesArray, 2), 2)
With rngRange_I.Worksheet
Dim InvertedRange As Range
Set InvertedRange = .Cells(ActualRow, ActualColumn)
For ArrayIndex = UBound(RangesArray, 1) To LBound(RangesArray, 1) Step -1
ActualRow = RangesArray(ArrayIndex, 1)
ActualColumn = RangesArray(ArrayIndex, 2)
Set InvertedRange = Application.Union(InvertedRange, _
.Cells(ActualRow, ActualColumn))
Next ArrayIndex
End With
Set InvertRange = InvertedRange
End Function
You can use a stack (LIFO data structure) for inventing your list and the code would be something like this:
Dim aStack as Object
Set aStack = CreateObject("System.Collections.Stack")
For Each arngCell in Selection.Cells
aStack.Push(arngCell)
Next
While aStack.Count > 0
rngCell = aStack.Pop
' ...
End While
Set stack = Nothing