I try to find the last cell in a column that contains values. I know I can use something like:
Dim findme As Range = excel.Range("A1:A" & lastrow.row)
but I am looking for a way not to use this column-character format. Something like this VBA format
Dim rng as range
with myWorksheet
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
rng = .Range(.Cells(1,1), .Cells(LastRow, 1))
end with
I created an helper class to solve this problem:
Imports Excel = Microsoft.Office.Interop.Excel
Public Class FindLastCellByIndex
Private Shared Function getStringRangeFormat(ByVal colNumber As Long, ByVal rowNumber As Long) As String
If colNumber > 0 AndAlso colNumber < 27 Then
Dim c As Char
c = Convert.ToChar(colNumber + 64)
Return (c & rowNumber & ":" & c).ToString
Else
Return ""
End If
End Function
Public Shared Function getSearchRange(ByRef _sheet As Excel.Worksheet, ByVal Col As Long, ByVal startRow As Long) As Excel.Range
Dim strColCharSpez As String = getStringRangeFormat(Col, startRow)
'Build String
Dim rng As Excel.Range = DirectCast(_sheet.Cells(_sheet.Rows.Count, startRow), Excel.Range)
Dim t As Long
t = rng.End(Excel.XlDirection.xlUp).Row
Return _sheet.Range(strColCharSpez & t)
End Function
End Class
This is the way to use it:
Dim rng As Excel.Range = FindLastCellByIndex.getSearchRange(_sheet, 3, 3)
Now you get the Range: Range(Cells(3,3), Cells(LastRow, 3) as an object.
Related
I keep getting the Argument not optional compiler error in vba and can't figure out why.
I can't see any typos, I don't even take any arguments and the subroutine only executes on a button click.
Public Sub SearchAMLinesForIDs_Click()
Dim time As String
time = "AM"
Dim end_row As Long
end_row = Range("A2").End(xlDown).row
Dim lookup_end_row As Long
Dim lookup_result As Long
lookup_end_row = ThisWorkbook.Sheets(time & "_Lines").Range("A2").End(xlDown).row
lookup_table = ThisWorkbook.Sheets(time & "_Lines").Range("A2:C" & lookup_end_row)
Dim row As Long
For row = 1 To end_row
lookup_result = WorksheetFunction.VLookup(Range("A" & row), lookup_table, 1, False)
Cells(row + 1, 2) = lookup_result
Next row
End Sub
Public Sub SearchAMLinesForIDs_Click()
Dim sTime As String, shtData As Worksheet, sht As Worksheet
Dim lookup_result, rngLookup As Range
Dim rw As Long
sTime = "AM"
Set shtData = ThisWorkbook.Worksheets(sTime & "_Lines")
Set sht = ActiveSheet
Set rngLookup = shtData.Range(shtData.Range("A2"), shtData.Cells(shtData.Rows.Count, 1).End(xlUp))
For rw = 2 To sht.Range("A2").End(xlDown).row
'don't use Worksheetfunction, but test the return value for errors...
lookup_result = Application.VLookup(sht.Cells(rw, 1), rngLookup, 1, False)
sht.Cells(rw, 2) = IIf(IsError(lookup_result), "NoMatch!", lookup_result)
Next rw
End Sub
Utilize your object browser if you're running into issues like this.
You can test your vlookup within a cell in a worksheet to verify validity.
Your parenthesis are in incorrect order.
lookup_result = WorksheetFunction.VLookup(Cells(1 + Row, 1), _
ThisWorkbook.Sheets(Time & "_Lines").Range(Cells(2, 1), Cells(lookup_end_row, 1)), _
1, _
False)
parenthesis opened for Range doesn't close and closed in the end.
I am trying to add a column (7) to a table and filling the cells in that column with a CONCATENATE of column (6) and (5)
I can make it work by using the header name but would like to use the column number instead. Any suggestions on how to make this work?
This is what I have:
Sub AddColAndName(ws As Worksheet, tbl As ListObject, newColPos As Long, newColName As String, conColPos1 As Long, conColPos2 As Long)
With tbl
.ListColumns.Add newColPos
.HeaderRowRange(newColPos) = newColName
.ListColumns(newColPos).DataBodyRange.FormulaR1C1 = "=CONCATENATE([#FinancialMonthNumberNameShort],[#FinancialYear])"
End With
With ws
.Columns(newColPos).EntireColumn.AutoFit
End With
End Sub
I would like to change the [#FinancialMonthNameShort] to the number passed as argument (conColPos1).. or any other way where I can use an argument passed to the Sub.
Thanks you all for helping.
//JATE
Like this
Option Explicit
Public Sub test()
Dim tbl As ListObject
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet17") 'change as required
Set tbl = ws.ListObjects("Table5") 'change as required
Dim newColPos As Long
Dim conColPos1 As Long
Dim conColPos2 As Long
If conColPos1 > tbl.Range.Columns.Count Or conColPos2 > tbl.Range.Columns.Count Then
MsgBox "Invalid columns for concatenation"
End
End If
conColPos1 = 2
conColPos2 = 3
newColPos = 4
Dim newColName As String
newColName = "NewColumn"
AddColAndName ws, tbl, newColPos, newColName, conColPos1, conColPos2
End Sub
Public Sub AddColAndName(ByVal ws As Worksheet,ByVal tbl As ListObject, ByVal newColPos As Long,ByVal newColName As String,ByVal conColPos1 As Long, ByVal conColPos2 As Long)
With tbl
If newColPos > .Range.Columns.Count Then
.ListColumns.Add .Range.Columns.Count + 1
Else
.Add newColPos
End If
.HeaderRowRange(newColPos) = newColName
.ListColumns(newColPos).DataBodyRange.Formula = "=CONCATENATE([#" & .HeaderRowRange(conColPos1) & "],[#" & .HeaderRowRange(conColPos2) & "])"
End With
With ws
.Columns(newColPos).EntireColumn.AutoFit
End With
End Sub
You could also swop out and use:
.ListColumns(newColPos).DataBodyRange.Formula = "=CONCATENATE([#" & .ListColumns(conColPos1).Cells(1, 1) & "],[#" & .ListColumns(conColPos2).Cells(1, 1) & "])"
I have a spreadsheet that has values for more than one month, so I am trying to first find the value based on a value in the wsRevFile worksheet and then ensure that this is the value from last month. When I use the following code, I get a "invalid number of arguments" error.
Sub RevLookup(wsMvFile As Worksheet, wsRevOld As Worksheet, wsNewRev As Worksheet, _
rowCount As Integer, workCol As String, _
srcCol1 As Integer, srcCol2 As Integer)
Dim vrw As Variant, i As Long
For i = 2 To rowCount
vrw = Application.Match(wsRevFile.Range("A" & i), wsNewRev.Columns(2), Format(DateSerial(Year(Date), Month(Date), 0), "mm/dd/yyyy"), wsNewRev.Columns(1), 0)
If IsError(vrw) Then
vrw = Application.Match(wsRevFile.Range("A" & i), wsRevOld.Columns(1), 0)
If Not IsError(vrw) Then _
wsRevFile.Range(workCol & i) = Application.Index(wsRevOld.Columns(srcCol1), vrw)
Else
wsRevFile.Range(workCol & i) = Application.Index(wsNewRev.Columns(srcCol2), vrw, 1)
End If
Next i
End Sub
I am assuming this has to do with the way I assigned the Application Match function, because the formula without this part works for other columns. Any ideas on how I could get this to work?
Thanks for your help!
Try ajusting the variables of the following procedure, as I didn't figure out your input and output data:
Sub Main()
Dim SearchValue As Variant
Dim SearchColumn As Range
Dim ReturnColumn As Range
Dim ResultRows As Collection
Dim LastDate As Variant 'Date?
Dim iRow As Variant
SearchValue = 10 '<-- change to suit
Set SearchColumn = wsNewRev.Range("B1:B10")
Set ReturnColumn = wsNewRev.Range("C1:C10") '<-- change to suit
Set ResultRows = GetLoopRows(SearchColumn, SearchValue)
For Each iRow In ResultRows
If LastDate < ReturnColumn(iRow) Then
LastDate = ReturnColumn(iRow)
End If
Next iRow
Debug.Print LastDate
End Sub
Function GetLoopRows(ParamArray pParameters() As Variant) As Collection
'Obtém limites de laços com levando em conta condições
'[vetor1], [valor1], [vetor2], [valor2], ...
Dim iCondition As Long
Dim i As Variant
Dim iRow As Variant
Dim Result As Collection
Dim NumConditions As Long
Dim SearchCollection As Collection
Dim ArraysCollection As Collection
Dim iArray As Variant
NumConditions = (UBound(pParameters) - LBound(pParameters) + 1) / 2
Set ArraysCollection = New Collection
Set SearchCollection = New Collection
For i = LBound(pParameters) To UBound(pParameters) Step 2
ArraysCollection.Add pParameters(i + 0).Value2
SearchCollection.Add pParameters(i + 1)
Next i
Set Result = New Collection
For iRow = LBound(ArraysCollection(1)) To UBound(ArraysCollection(1))
For iCondition = 1 To NumConditions
If ArraysCollection(iCondition)(iRow, 1) <> SearchCollection(iCondition) Then GoTo Continue
Next iCondition
Result.Add CLng(iRow)
Continue:
Next iRow
Quit:
Set GetLoopRows = Result
End Function
In VBA, why does the following fail?
Dim rng as Range
rng = Range("Sheet1:Sheet3!A1")
It throws an HRESULT exception. Is there another way to construct this range in VBA? Note that you can enter a worksheet function like =SUM(Sheet1:Sheet3!A1) and it works fine.
A Range object is limited to only one worksheet. After all, it can have only a single parent.
The =SUM() function can operate on a group of ranges. (this is true for many worksheet functions)
EDIT#1
I have been searching for a solution since Janauary:
UDF Syntax
.
I have been using an array of ranges. Not a very good solution.
Just developing Gary's answer (if you're going to accept an answer, accept his :):
Using Range variable:
Sub SumTest1()
Dim rSheet1 As Range
Dim rSheet2 As Range
Dim rSheet3 As Range
Dim dSum As Double
With ThisWorkbook
Set rSheet1 = .Sheets("Sheet1").Range("A1")
Set rSheet2 = .Sheets("Sheet2").Range("A1")
Set rSheet3 = .Sheets("Sheet3").Range("A1")
End With
dSum = WorksheetFunction.Sum(rSheet1, rSheet2, rSheet3)
Debug.Print CStr(dSum)
End Sub
Using Variant variable:
Sub SumTest2()
Dim vArray As Variant
Dim dSum As Double
With ThisWorkbook
vArray = Array(.Sheets("Sheet1").Range("A1"), .Sheets("Sheet2").Range("A1"), .Sheets("Sheet3").Range("A1"))
End With
dSum = WorksheetFunction.Sum(vArray)
Debug.Print CStr(dSum)
End Sub
Using no variable:
Sub SumTest3()
Dim dSum As Double
With ThisWorkbook
dSum = WorksheetFunction.Sum(Array(.Sheets("Sheet1").Range("A1"), .Sheets("Sheet2").Range("A1"), .Sheets("Sheet3").Range("A1")))
End With
Debug.Print CStr(dSum)
End Sub
Here's a set of UDF functions that accomplish essentially the same thing. The only caveat is that the reference to the 3D range is a string i.e. "Jan:Dec!A1" as opposed to straight up Jan:Dec!A1
'Adapted from https://web-beta.archive.org/web/20060313132405/http://www.j-walk.com/ss/excel/eee/eee003.txt by Andre Terra
Function CountIf3D(Range3D As String, Criteria As String, _
Optional Count_Range As Variant) As Variant
Dim sTestRange As String
Dim sCountRange As String
Dim Sheet1 As Integer
Dim Sheet2 As Integer
Dim n As Integer
Dim Count As Double
Application.Volatile
If Parse3DRange(Application.Caller.Parent.Parent.Name, _
Range3D, Sheet1, Sheet2, sTestRange) = False Then
CountIf3D = CVErr(xlErrRef)
End If
If IsMissing(Count_Range) Then
sCountRange = sTestRange
Else
sCountRange = Count_Range.Address
End If
Count = 0
For n = Sheet1 To Sheet2
With Worksheets(n)
Count = Count + Application.WorksheetFunction.CountIf(.Range _
(sTestRange), Criteria)
End With
Next n
CountIf3D = Count
End Function 'CountIf3D
Function SumIf3D(Range3D As String, Criteria As String, _
Optional Sum_Range As Variant) As Variant
Dim sTestRange As String
Dim sSumRange As String
Dim Sheet1 As Integer
Dim Sheet2 As Integer
Dim n As Integer
Dim Sum As Double
Application.Volatile
If Parse3DRange(Application.Caller.Parent.Parent.Name, _
Range3D, Sheet1, Sheet2, sTestRange) = False Then
SumIf3D = CVErr(xlErrRef)
End If
If IsMissing(Sum_Range) Then
sSumRange = sTestRange
Else
sSumRange = Sum_Range.Address
End If
Sum = 0
For n = Sheet1 To Sheet2
With Worksheets(n)
Sum = Sum + Application.WorksheetFunction.SumIf(.Range _
(sTestRange), Criteria, .Range(sSumRange))
End With
Next n
SumIf3D = Sum
End Function 'SumIf3D
Function AverageIf3D(Range3D As String, Criteria As String, _
Optional Average_Range As Variant) As Variant
Dim sTestRange As String
Dim sSumRange As String
Dim Sheet1 As Integer
Dim Sheet2 As Integer
Dim n As Integer
Dim Sum As Double
Dim Count As Double
Application.Volatile
If Parse3DRange(Application.Caller.Parent.Parent.Name, _
Range3D, Sheet1, Sheet2, sTestRange) = False Then
AverageIf3D = CVErr(xlErrRef)
End If
If IsMissing(Average_Range) Then
sSumRange = sTestRange
Else
sSumRange = Average_Range.Address
End If
Sum = 0
Count = 0
For n = Sheet1 To Sheet2
With Worksheets(n)
Sum = Sum + Application.WorksheetFunction.SumIf(.Range(sTestRange), Criteria, .Range(sSumRange))
Count = Count + Application.WorksheetFunction.CountIf(.Range(sTestRange), Criteria)
End With
Next n
AverageIf3D = Sum / Count
End Function 'SumIf3D
Function Parse3DRange(sBook As String, SheetsAndRange _
As String, FirstSheet As Integer, LastSheet As Integer, _
sRange As String) As Boolean
Dim sTemp As String
Dim i As Integer
Dim Sheet1 As String
Dim Sheet2 As String
Parse3DRange = False
On Error GoTo Parse3DRangeError
sTemp = SheetsAndRange
i = InStr(sTemp, "!")
If i = 0 Then Exit Function
'next line will generate an error if range is invalid
'if it's OK, it will be converted to absolute form
sRange = Range(Mid$(sTemp, i + 1)).Address
sTemp = Left$(sTemp, i - 1)
i = InStr(sTemp, ":")
Sheet2 = Trim(Mid$(sTemp, i + 1))
If i > 0 Then
Sheet1 = Trim(Left$(sTemp, i - 1))
Else
Sheet1 = Sheet2
End If
'next lines will generate errors if sheet names are invalid
With Workbooks(sBook)
FirstSheet = .Worksheets(Sheet1).Index
LastSheet = .Worksheets(Sheet2).Index
'swap if out of order
If FirstSheet > LastSheet Then
i = FirstSheet
FirstSheet = LastSheet
LastSheet = i
End If
i = .Worksheets.Count
If FirstSheet >= 1 And LastSheet <= i Then
Parse3DRange = True
End If
End With
Parse3DRangeError:
On Error GoTo 0
Exit Function
End Function 'Parse3DRange
Untested, but try this
Dim rng as string
rng = "Sheet1:Sheet3!A1"
worksheet("Sheet1").range("B1").formula = "=SUM(" & rng & ")"
This works Lastrow = 8, but not 9 (Type mismatch)
If i remove If Not (myarray = Empty) Then it does not work for 8
What is the easiest way to solve this?
Public Function GetRowToWriteOn(ByVal SheetName As String, ByVal idnr As Integer) As Integer
LastRow = (Sheets(SheetName).UsedRange.Rows.Count) + 1
MsgBox (LastRow)
myarray = Sheets(SheetName).Range("d8:d" & LastRow).Value
If Not (myarray = Empty) Then
For row = 1 To UBound(myarray, 1)
If (myarray(row, 1) = idnr) Then
GetRowToWriteOn = row
Exit Function
End If
Next
End If
GetRowToWriteOn = LastRow
Exit Function
End Function
MyArray is taking 2 different types, depending on the range given.
If you are looking at 1 cell, then it is a single variant (which can be tested if it is Empty)
If you are looking at 2 or more cells, then it becomes an array of variant, so you would have to test each cell.
myarray = Sheets(SheetName).Range("d8:d8").Value - myarray gets the value in d8
myarray = Sheets(SheetName).Range("d8:d9").Value - myarray(1,1) gets the value in d8, and myarray(2,1) gets the value in d9
to test, use:
if vartype(myarray)=vbArray then
' run through the array
else
' do single value stuff
endif
I feel like your code should look more like this
Option Explicit
Public Function GetRowToWriteOn(ByVal SheetName As String, ByVal idnr As Integer) As Integer
Dim lastrow As Long, row As Long
lastrow = (Sheets(SheetName).UsedRange.Rows.Count) + 1
MsgBox (lastrow)
Dim myarray() As Variant
myarray = Sheets(SheetName).Range("d8:d" & lastrow).Value
If Not (IsEmpty(myarray)) Then
For row = 1 To UBound(myarray, 1)
If (myarray(row, 1) = idnr) Then
GetRowToWriteOn = row
Exit Function
End If
Next
End If
GetRowToWriteOn = lastrow
Exit Function
End Function
BUT I also think there is another way to do what you want. A little simpler and used built in functions. I think I captured your intention here:
Dim RowToWriteOn As Long, SheetName As String, lastRow As Long
Dim rng As Range
SheetName = "Sheet1"
lastRow = (Sheets(SheetName).UsedRange.Rows.Count) + 1
Set rng = Sheets(SheetName).Range("d" & lastRow)
RowToWriteOn = rng.End(xlUp).row
Public Function GetRowToWriteOn(ByVal SheetName As String, _
ByVal idnr As Integer) As Long
Dim lastRow As Long, f As Range
lastRow = Sheets(SheetName).Cells(Rows.Count, 4).End(xlUp).Row
Set f = Sheets(SheetName).Range("D8:D" & lastRow).Find(what:=idnr, _
lookat:=xlWhole)
If Not f Is Nothing Then
GetRowToWriteOn = f.Row
Else
GetRowToWriteOn = lastRow + 1
End If
End Function
myarray = Sheets(SheetName).Range("d8:d" & LastRow)
(without value)...
And you can use: if ubound(myArray) > 1 then ;..
I think it could be as easy as this, no...?