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)
Related
I am attempting to practice my VBA skills by coding the equivalent of SUMX2MY2 in my own function, mySUMX2MY2 (I realize I could use =SUMPRODUCT but I'm practicing functions). I'm trying to do it by creating two arrays from whatever ranges are selected and squaring the ranges and minus the second squared range. Each time I try in excel, I get the error #VALUE. My guess is the error is with the argument my function is returning but I'm not sure how to fix it.
Sub main()
End Sub
Function mySumX2MY2(n1 As Range, n2 As Range) As Variant
Dim n1Array() As Variant
Dim n2Array() As Variant
Dim total As Variant
Dim i As Integer
Dim aCell As Variant
i = 1
ReDim n1Array(n1.Count)
ReDim n2Array(n2.Count)
For Each aCell In n1
n1Array(i) = aCell.Value
i = i + 1
Next
For Each aCell In n2
n2Array(i) = aCell.Value
i = i + 1
Next
i = 1
For i = 1 To n1.Rows.Count
total = total + (n1Array(i) * n1Array(i) - n2Array(i) * n2Array(i))
i = i + 1
Next
mySumX2MY2 = total
End Function
I'm trying to write a custom DeleteRows Sub that I can call from various points in my code, but I am running into an issue where the worksheet I am passing in doesn't seem to have any cells associated with it, and run into "Type Mismatch" errors when running it. I am sorting to get a certain value to appear at the beginning and then looping through to see how many cells it appears in and then deleting those rows.
Option Explicit
Public Sub DeleteRows(ByRef MySheet As Worksheet, RowsToDelete As Long, ColumnToUse As String, ValueToSearch As String, UseAsInt As Boolean)
Dim MyLong As Long
If UseAsInt Then 'We are looking for a numeric value
MyLong = CLng(ValueToSearch)
Do While MySheet.Cells(RowsToDelete, ColumnToUse).Value = MyLong
RowsToDelete = RowsToDelete + 1
Loop
Else
Do While MySheet.Cells(RowsToDelete, ColumnToUse).Value = ValueToSearch
RowsToDelete = RowsToDelete + 1
Loop
End If
If RowsToDelete > 2 Then 'If the row is 2 then no rows were found
MySheet.Rows(2 & ":" & RowsToDelete - 1).Delete 'Delete the rows up to the lastRowToDelete minus 1 row(because it started at 2)
End If
End Sub
I am calling it from another Sub:
Dim CurDay as Worksheet
Set CurDay = Sheets("Current Day")
Call DeleteRows(CurDay, 2, "L","#N/A", False)
However when I add a watch to MySheet in the DeleteRows Sub, it says there are no cells in the array and I get a Type Mismatch error. Where am I going wrong here? VBA is so frustrating at times coming from a C#/VB.Net background...
UPDATE: Found out I had to check for .Text instead of .Value or .Value2 and it works...
That's not how you should compare error cells. When the cell is #N/A you cannot compare it to something else like a string or a number. You should first check if the value is an error using IsError(cel).
Alternatively you can use the .Text property, which works fine with erroneous cells, returning a "#N/A" string instead of an Error Variant.
You then have to face the issue of comparing strings to numbers. Easiest, drop the UseAsInt parameter; use always a string and compare toward the .Text property.
Public Sub DeleteRows(ByRef MySheet As Worksheet, RowsToDelete As Long, ColumnToUse As String, ValueToSearch As String)
Do While MySheet.Cells(RowsToDelete, ColumnToUse).Text = ValueToSearch
RowsToDelete = RowsToDelete + 1
Loop
If RowsToDelete > 2 Then 'If the row is 2 then no rows were found
MySheet.Rows(2 & ":" & RowsToDelete - 1).Delete 'Delete the rows up to the lastRowToDelete minus 1 row(because it started at 2)
End If
End Sub
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 getting Error '424': Object Required When I try to run the following subroutine:
Sub MySub()
'Iterate through column, setting corresponding values
For Each cell In Range("Table5[Name]")
cell.Offset(, 2).Value = Avg("Table2[time]", cell.Value, "Table2[name]")
cell.Offset(, 3).Value = StDev("Table2[time]", cell.Value, "Table2[name]", cell.Offset(, 2).Value)
Next
End Sub
When I press debug, it highlights the second line inside the For loop. Both Avg and StDev are functions I wrote to work similarly to AVERAGEIF, but in a very specific scenario.
The Avg function works exactly as intended, and StDev is almost identical. It has one extra If statement, and the math is almost identical. Both functions return a Variant.
I can't figure out why it's doing this. So far I've tried adding Set in front of the troublesome line (I knew it wouldn't work, but I had to try anyway), and I've made sure both functions are safe (i.e. they do not divide by zero, and they always return a value).
Here's the StDev function (modified to protect work confidentiality, but has same issue):
Function StDev(rng As Range, Criteria1 As Variant, Criteria_Rng1 As String, Optional avg As Variant) As Variant
'Call like this
' StDev2Ifs(Range to StDev, Match this, Range to find Criteria1, [average])
If IsMissing(avg) Then
avg = Avg(rng, Critera1, Criteria_Rng1)
End If
If avg <> "NO DATA" Then
'Convert Strings to Ranges
Dim c_rng, c_rng1 As Range
Set c_rng = Application.Range(rng)
Set c_rng1 = Application.Range(Criteria_Rng1)
'Get Column Indices
Dim r, r1As Long
r = c_rng.Columns(c_rng.Columns.Count).Column
r1 = c_rng1.Columns(c_rng1.Columns.Count).Column
'Calculate column offsets from range to stdev
Dim off1 As Long
off1 = r1 - r
'x will be used to sum the elements
Dim x As Double
x = 0
'ct will be used to count number of elements
Dim ct As Double
ct = 0
For Each cell In Range(rng)
If cell.Offset(, off1).Value = Criteria1 Then
x = x + Square(cell.Value - avg)
ct = ct + 1
End If
Next
'Divide by count
If ct <> 0 Then
StDev = x / ct
Else
StDev = "NO DATA"
End If
'Square Root
If ct <> 0 Then
StDev = StDev ^ (1 / 2)
End If
Else
StDev = "NO DATA"
End If
End Function
Anybody have any ideas?
cell.Offset(, 3).Value = StDev("Table2[time]", cell.Value, "Table2[name]", cell.Offset(, 2).Value)
in the first code block should be
cell.Offset(, 3).Value = StDev(Range("Table2[time]"), cell.Value, "Table2[name]", cell.Offset(, 2).Value)
if you intend to pass a range as the function expects. You will run to an error tough because in your function StDev seems to be built for it to be passed as string so I suggest that you correct your function from
Function StDev(rng As Range, Criteria1 As Variant, Criteria_Rng1 As String, Optional avg As Variant) As Variant
to
Function StDev(rng As String, Criteria1 As Variant, Criteria_Rng1 As String, Optional avg As Variant) As Variant
Quick check so be careful, I might have missed something.
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