I'm trying to set up VB so I can do a VLOOKUP on a dynamic range of values. It'll always start at the same place, but it may end further down based on whatever value is in H4.
EDIT: Here's the code and it works.
Thank you Alex!
Public Sub State()
Dim refRng As Range, ref As Range, dataRng As Range
Dim i As Variant
Dim count As Integer
i = Sheet2.Range("H1").Value
i = i + 3 'offset of when to start
Set refRng = Sheet2.Range("D8:" & Cells(8, i).Address) '//horizontal range of look up values
Set dataRng = Sheet13.Range("A:C") '//data block you want to look up value in
For Each ref In refRng
ref.Offset(1, 0) = Application.WorksheetFunction.VLookup(refRng, dataRng, 2, True)
Next ref
End Sub
This may help:
Sub LookUp()
Dim refRng As Range, ref As Range, dataRng As Range
Set refRng = Worksheets(1).Range("D8:F8") //horizontal range of look up values
Set dataRng = Worksheets(2).Range("A1:B4") //data block you want to look up value in
For Each ref In refRng
ref.Offset(1, 0) = WorksheetFunction.VLookup(ref, dataRng, 2, 0)
Next ref
End Sub
Here you set up references to your lookup values and the data you want to query. Then just iterate over the values in the horizontal range and look up the value.
Related
Trying to use match & Index with specified ranges. Does not recognise RefreshDrNumbers in the code.
I am using the Case Function to specify ranges.
Can't seem to make the Case, Match & Index function connect or talk to each other?
The other Forum I've asked is
https://www.mrexcel.com/board/threads/add-ranges-to-match-and-index-functions.1162701/
Private Sub Jobcard_Demands_Click()
If Jobcard_Demands = ("Drawing No`s Update") Then
Dim matchRange As Range
Dim ODict As Object
Dim PartsListLastRow As Long, DestLastRow As Long
Dim LookupRange As Range
Dim i As Integer
Dim wsSource As Worksheet, wsDest As Worksheet
Set wsSource = ThisWorkbook.Worksheets("Parts List")
Set wsDest = ThisWorkbook.Worksheets("Job Card Master")
PartsListLastRow = wsSource.Range("A" & Rows.Count).End(xlUp).Row
DestLastRow = wsDest.Range("A" & Rows.Count).End(xlUp).Row
'This holds the lookup range (including both the lookup key
'column and the value column)
Set matchRange = wsSource.Range("E1:F" & PartsListLastRow)
'Get a dictionary of all the lookup values. The function, as
'defined below, takes the range as well as the relative column
'of the keys and values. In our case, the first column of our
'range has the keys, and the second has the values
Set ODict = GetDictionary(matchRange, 5, 6)
'Below, define the lookup range. In your specific code, this
'varies based on the combobox value, but I think you'll be able
'to figure out how to define it (I'm just hardcoding mine
Set LookupRange = wsDest.Range("A1:A" & DestLastRow)
'Loop over the lookup range
For i = 1 To DestLastRow
'Since the GetPartInfo function handles cases where there isn't a match
' (it returns a blank string), you don't have to use an if/else statement
wsDest.Range("B" & i).Value = GetPartInfo(ODict, wsDest.Range("E" & i).Value)
Next i
End If
End Sub
Private Function GetDictionary(rng As Range, keyCol As Long, valCol As Long) As Object
Dim sht As Worksheet
Dim rCell As Range
Dim ODict As Object
Set sht = rng.Parent
Set ODict = CreateObject("Scripting.Dictionary")
For Each rCell In rng.Columns(keyCol).Cells
If Not ODict.Exists(rCell.Offset(, keyCol - 1).Value) Then
ODict.Add rCell.Offset(, keyCol - 1).Value, rCell.Offset(, valCol - 1).Value
End If
Next rCell
Set GetDictionary = ODict
End Function
'This is just a helper function to de-clutter the main subroutine. Returns an
' empty string in cases where the part doesn't exist in the dictionary
Private Function GetPartInfo(ByRef ODict As Object, sKey As String)
Dim Output As String
Output = ""
If ODict.Exists(sKey) Then
Output = ODict(sKey)
End If
GetPartInfo = Output
End Function
Whenever I'm working with code that performs many lookups over the same range, I tend to package that lookup range into a dictionary. Lookups in a dictionary are highly efficient, so you don't have to worry about the "cost" of the lookup. There is an overhead to populate the dictionary, but this is often recovered as the number of lookups grows.
I took that approach in the below solution. I use helper functions to create the dictionary and to lookup dictionary values. This helps to declutter the main routine. See if you can work with the code below, and adapt it to your solution. I commented it where I felt it would add value, and I think you should be able to adapt to your needs. Write back with any issues.
Sub RefreshStuff()
Dim matchRange As Range
Dim oDict As Object
Dim lastRow As Long
Dim lookupRange As Range
Dim wsDest As Worksheet
'This holds the lookup range (including both the lookup key
'column and the value column)
Set matchRange = Sheets("Parts List").Range("E1:F6")
'Get a dictionary of all the lookup values. The function, as
'defined below, takes the range as well as the relative column
'of the keys and values. In our case, the first column of our
'range has the keys, and the second has the values
Set oDict = GetDictionary(matchRange, 1, 2)
'Below, define the lookup range. In your specific code, this
'varies based on the combobox value, but I think you'll be able
'to figure out how to define it (I'm just hardcoding mine
lastRow = 10
Set wsDest = Sheets("Job Card Master")
Set lookupRange = wsDest.Range("A1:A" & lastRow)
'Loop over the lookup range
For i = 1 To lastRow
'Since the GetPartInfo function handles cases where there isn't a match
' (it returns a blank string), you don't have to use an if/else statement
wsDest.Range("B" & i).Value = GetPartInfo(oDict, wsDest.Range("A" & i).Value)
Next i
End Sub
Private Function GetDictionary(rng As Range, keyCol As Long, valCol As Long) As Object
Dim sht As Worksheet
Dim rCell As Range
Dim oDict As Object
Set sht = rng.Parent
Set oDict = CreateObject("Scripting.Dictionary")
For Each rCell In rng.Columns(keyCol).Cells
If Not oDict.exists(rCell.Offset(, keyCol - 1).Value) Then
oDict.Add rCell.Offset(, keyCol - 1).Value, rCell.Offset(, valCol - 1).Value
End If
Next rCell
Set GetDictionary = oDict
End Function
'This is just a helper function to de-clutter the main subroutine. Returns an
' empty string in cases where the part doesn't exist in the dictionary
Private Function GetPartInfo(ByRef oDict As Object, sKey As String)
Dim output As String
output = ""
If oDict.exists(sKey) Then
output = oDict(sKey)
End If
GetPartInfo = output
End Function
I am trying to replicate a simple excel function into VBA but I get Type mismatch error. Basically, I have two named ranges rDate and rYear and the following Excel function that works perfectly giving the following output:
=IF(YEAR(rDate)=rYear,rYear,"")
https://www.screencast.com/t/rPpsVjudqrI
However, as I mentionned, I get a Type mismatch error when trying to convert it to VBA. Here is my code:
Public ws As Worksheet
Sub Test()
Dim rDate, rYear, rResult, cell As Range
Set ws = Worksheets("Sheet1")
Set rDate = ws.Range("rDate")
Set rYear = ws.Range("rYear")
Set rResult = ws.Range("rResult")
For Each cell In rResult
If Year(rDate) = rYear Then 'Problematic line
cell = rYear
Else
cell = ""
End If
Next
End Sub
Please let me know what I am doing wrong. Thank you
vba reacts differently to ranges than the worksheet. In vba one needs to compare the value of one cell to one value not a multi-cell range to a multi-cell range.
instead of trying to equate the whole range pick the one cell in each range based on where cell is located.
To get the correct reference on the vertical range we want to find the relative row:
rDate.Cells(cell.Row - rResult.Row + 1, 1)
and the relative column:
rYear.Cells(1, cell.Column - rResult.Column + 1)
Then:
Dim rDate, rYear, rResult, cell As Range
only will declare cell as a range and the others as Variant.
So use:
Dim rDate As Range, rYear As Range, rResult As Range, cell As Range
The worksheet function is making assumptions on row and column based on the relative location of the formula, that vba does not.
Public ws As Worksheet
Sub Test()
Dim rDate As Range, rYear As Range, rResult As Range, cell As Range
Set ws = Worksheets("Sheet1")
Set rDate = ws.Range("rDate")
Set rYear = ws.Range("rYear")
Set rResult = ws.Range("rResult")
For Each cell In rResult
If Year(rDate.Cells(cell.Row - rResult.Row + 1, 1)) = rYear.Cells(1, cell.Column - rResult.Column + 1) Then 'Problematic line
cell = rYear.Cells(1, cell.Column - rResult.Column + 1)
Else
cell = ""
End If
Next
End Sub
A quicker method would be to load the data into memory arrays and loop through those.
Public ws As Worksheet
Sub Test()
Dim rDate, rYear, rResult
Dim i As Long, j As Long
Set ws = Worksheets("Sheet1")
rDate = ws.Range("rDate").Value
rYear = ws.Range("rYear").Value
ReDim rResult(1 To UBound(rDate, 1), 1 To UBound(rYear, 2))
For i = LBound(rDate, 1) To UBound(rDate, 1)
For j = LBound(rYear, 2) To UBound(rYear, 2)
If rYear(1, j) = Year(rDate(i, 1)) Then
rResult(i, j) = rYear(1, j)
Exit For
End If
Next j
Next i
ws.Range("rResult").Value = rResult
End Sub
Every time one accesses the worksheet from vba it slows down the code. With this method we only access the worksheet 3 times, regardless of how large the ranges are.
I am trying to write a code that checks if two cells on two different worksheets are the same. And, if they are the same, uses VLOOKUP to find the difference between assigned values for those cells (which are in a different column)
This is what I have written so far, and I keep getting the error message
Object doesn't support this property or method
and can not figure out why. Can anyone give input? Thanks!
Sub testing()
Product = Range("A2:A506")
Set myrange = Worksheets("open_prices").Range("A2:D506")
Set myrange2 = Worksheets("close_prices").Range("A2:B506")
Dim popen As Integer
Dim pclose As Integer
Dim ws As Worksheet
For Each Cell In Workbooks("TDO VBA Test.xlsx")
If Worksheets("open_prices").Range("A2:A506") = Worksheets("close_prices").Range("A2:A506") Then
popen = WorksheetFunction.VLookup(Product, myrange, 4, False)
pclose = WorksheetFunction.VLookup(Product, myrange2, 2, False)
result = popen - pclose
End If
Next Cell
End Sub
I am guessing that this is what you are trying to do, i.e. iterate over each cell in one sheet's A2:A506 and see if the value is in the other sheet and, if it is, do the calculation.
Sub testing()
Dim popen As Integer
Dim pclose As Integer
Dim result As Integer ' Are you sure these are integers? Usually prices will be Double
Dim VLookupResult As Variant
Dim cel As Range
For Each cel In Worksheets("open_prices").Range("A2:A506").Cells
popen = cel.Offset(0, 3).Value
VLookupResult = Application.VLookup(cel.Value, Worksheets("close_prices").Range("A2:B506"), 2, False)
If Not IsError(VLookupResult) Then
pclose = VLookupResult
result = popen - pclose
' You will need to decide what to do with this "result" now
' that it has been calculated
End If
Next cel
End Sub
I believe I'm looking for the inverse of the Range Function. I have a named range in my worksheet and in an event macro. I'm interested in getting the range definition string back, such as "A1:A12".
Here is the code I'm working on:
Private Sub UserForm_Initialize()
Dim MyData As Range
Dim r As Long
With Me.ListBox1
.RowSource = ""
Set MyData = Worksheets("Sheet1").Range("A2:D100") 'Adjust the range accordingly
.List = MyData.Cells.Value
For r = .ListCount - 1 To 0 Step -1
If .List(r, 3) = "" Then
.RemoveItem r
End If
Next r
End With
End Sub
I'd rather use the name of the Range in the "Set MyData =" statement above instead of hard-coding the range in the event macro.
If you simply want the address of a Range, use
Dim MyRange as Range
Set MyRange = Worksheets("Sheet1").Range("A2:D100")
' Here do what you want
Msgbox MyRange.Address
.Address will return the "A2:D100" address
https://msdn.microsoft.com/fr-fr/library/office/ff837625.aspx
How to find location of last cell from defined Range? Cell does not have to contain any data but must be most right and most down located cell from certain Range.
Set rngOrigin = wksOrigin.Cells(IntFirstRow, IntFirstColumn).CurrentRegion
I wish to receive
Cells(i,j)
Perhaps this is what you want:
Dim rngLastCell As Range
Set rngLastCell = rngOrigin(rngOrigin.Count)
maybe you're after this:
'absolute indexes from cell A1
With rngOrigin
i = .Rows(.Rows.count).row
j = .Columns(.Columns.count).Column
End With
'relative indexes from rngOrigin upleftmost cell
With rngOrigin
i = .Rows(.Rows.count).row - .Rows(1).row + 1
j = .Columns(.Columns.count).Column - .Columns(1).Column + 1
End With
I handled it in below code but your remarks were helpful. Thank you.
intLastRow = rngOrigin.Cells(1, 1).Row + rngOrigin.Rows.Count - 1
intLastCol = rngOrigin.Cells(1, 1).Column + rngOrigin.Columns.Count - 1
The answers given by others mostly work, but not if the region is a union of non-contiguous cells. Here is a version that works consistently for single and multi-area regions, contiguous and non-contiguous.
Function LastCellOfRange(rng As Excel.Range) As Excel.Range
Dim area As Excel.Range
Dim rowNum As Long
Dim maxRow As Long
Dim colNum As Long
Dim maxCol As Long
Dim areaIdx As Integer
Set LastCellOfRange = Nothing
maxRow = 0
maxCol = 0
For areaIdx = 1 To rng.Areas.Count
Set area = rng.Areas(areaIdx)
rowNum = area.Cells(area.Cells.Count).row
If (rowNum > maxRow) Then
maxRow = rowNum
End If
colNum = area.Cells(area.Cells.Count).Column
If (colNum > maxCol) Then
maxCol = colNum
End If
Next areaIdx
Set LastCellOfRange = rng.Worksheet.Cells(maxRow, maxCol)
Set area = Nothing
End Function
Use this to code find the last cell in a given range
Sub GetLastCellFromRange()
Dim rng As Range
Set rng = Range("$C$10:$E$20")
'Set rng = Range(Selection.Address) ' Use this line to select the range in worksheet
MsgBox "Last Cell of given range is : " & rng.Cells(rng.Rows.Count, rng.Columns.Count).Address
End Sub
I hope it will help you
you could try the following but it relies upon cells always being populated
rngOrigin.End(xlDown).End(xlRight)
or you could use the CurrentRegion and count the rows and columns and use Offset
Alternatively, you could use this construct which works even with ranges based on entire rows or entire columns.
Sub Test()
Dim rngOrigin As Excel.Range
Set rngOrigin = Range("$A$1:$D$6")
Dim rngLast As Excel.Range
Set rngLast = rngOrigin.Cells(rngOrigin.Cells.Count)
Debug.Print rngLast.Address
End Sub
Finally, for ranges with multiple areas you'll have to script against a range's Areas collection ...
Sub Test()
Dim rngOrigin As Excel.Range
Set rngOrigin = Range("$A$1:$D$6,$F$1:$G$6")
Debug.Print rngOrigin.Areas(1).Cells(rngOrigin.Areas(1).Cells.Count).Address
Debug.Print rngOrigin.Areas(2).Cells(rngOrigin.Areas(2).Cells.Count).Address
End Sub
Many answers here will work as long as the given range is continuous. This is what I would use for a range that you are absolutely sure is going to be continuous:
Sub test()
Dim myRng As Range, lastCell As Range
Set myRng = Range("A1:D4")
Set lastCell = myRng.Cells(myRng.Rows.Count, myRng.Columns.Count)
Debug.Print lastCell.Address 'returns $D$4
End Sub
For non-continuous, DB user10082797 gave a great solution, however their function fails when the ranges are positioned diagonal-up (for example, if you pass rng=A3:B4,C1:D2 in you will get D4 as the output which was not part of the original range.)
So the question becomes, what is the last cell in the range A3:B4,C1:D2? Is it B4 or D2? That's a decision for the programmer. Here is a function I wrote with the help of DB user10082797's function:
Function LastCellOfRange(rng As Range, Optional returnLastRow As Boolean = True) As Range
'returns the last cell in #rng.
'if #returnLastRow is TRUE, then the output will always be in the right most cell of the last row of #rng
'if #returnLastRow is FALSE, then the output will always be in the bottom most cell of the last column of #rng
'(#returnLastRow only matters for non-contiguous ranges under certain circumstances.)
'initialize variables
Dim area As Range, areaIdx As Long
Dim lastCellInArea As Range
'loop thru each area in the selection
For areaIdx = 1 To rng.Areas.Count
Set area = rng.Areas(areaIdx) 'get next area
Set lastCellInArea = area.Cells(area.Rows.Count, area.Columns.Count) 'get the last cell in the area
'if:
' the return is empty
' OR if the last row needs to be returned and this row is larger than the last area's
' OR if the last row needs to be returned and this row is the same as the last area's but has a larger column
' OR if the last column needs to be returned and this column is larger than the last area's
' OR if the last column needs to be returned and this column is the same as the last area's but has a larger row
'THEN:
' make this cell the return range
If LastCellOfRange Is Nothing Then
Set LastCellOfRange = lastCellInArea '(must be seperate from the other statment when its not set to anything)
ElseIf _
returnLastRow = True And lastCellInArea.Row > LastCellOfRange.Row _
Or returnLastRow = True And lastCellInArea.Row = LastCellOfRange.Row And lastCellInArea.Column > LastCellOfRange.Column _
Or returnLastRow = False And lastCellInArea.Column > LastCellOfRange.Column _
Or returnLastRow = False And lastCellInArea.Column = LastCellOfRange.Column And lastCellInArea.Row > LastCellOfRange.Row _
Then
Set LastCellOfRange = lastCellInArea
End If
Next areaIdx
End Function
You can use the function like this:
Sub test()
Dim myRng As Range
Set myRng = Range("A3:B4,C1:D2")
Debug.Print LastCellOfRange(myRng).Address 'returns $B$4
Debug.Print LastCellOfRange(myRng, False).Address 'returns $D$2
End Sub
In your case, since you want to find the cell to the most right and down in your wksOrigin (defined as Worksheet), you could use the SpecialCells(xlCellTypeLastCell) to get the last cell Row and Column.
i = wksOrigin.Cells.SpecialCells(xlCellTypeLastCell).Row ' <-- get last row number
j = wksOrigin.Cells.SpecialCells(xlCellTypeLastCell).Column ' <-- get last column number
If you want to debug your result, you can add:
MsgBox "Last row at " & i & ", last column at " & j
If you want the absolute last cell of a defined range, regardless of whether it has any content, here is a simple solution
Dim InputRng As Range 'define a range for the test'
Set InputRng = Range("$F$3:$F$15")
MsgBox InputRng(1).Address & ":" & InputRng(InputRng.Cells.Count).Address 'This would output the absolute address of defined range'