I am facing problem while calling sub. Error message is wrong number of arguments or invalid property assignment. I tried many variations and nothing worked at all.
Sub last_non_empty_cell_in_a_row()
Dim rngCell As Range, i As Long
Set rngCell = Cells.Find(What:="*", After:=Cells(1, 1), LookIn:=xlFormulas,
LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:= _
False, SearchFormat:=False) '.Activate
i = rngCell.Row
End Sub
Sub code_main()
Dim x As Long
Call last_non_empty_cell_in_a_row(i)
For x = 1 To i
If Range("R" & x) = "m_M" Then
If Range("P" & x) = "m_DH" Then
If Range("Q" & x) = "" Then
Else
Range("P" & x, "R" & x).Interior.ColorIndex = 22
End If
Else
Range("P" & x, "R" & x).Interior.ColorIndex = 22
End If
Else
Range("P" & x, "R" & x).Interior.ColorIndex = 0
End If
Next x
End Sub
You want to change last_non_empty_cell_in_a_row to a Function and have it return the value of i.
Function last_non_empty_cell_in_a_row() As Long
Dim rngCell As Range, i As Long
Set rngCell = Cells.Find(What:="*", After:=Cells(1, 1), LookIn:=xlFormulas,
LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:= _
False, SearchFormat:=False) '.Activate
i = rngCell.Row
last_non_empty_cell_in_a_row = i
End Function
And then, in the calling procedure:
Sub code_main()
Dim x As Long
For x = 1 to last_non_empty_cell_in_a_row()
...
There may be other problems or errors, I did not test. Notably, last_non_empty_cell_in_a_row seems to be a function signature that does not really describe what the function returns. For ways to get the "last cell" in a given range or sheet, see:
Error in finding last used cell in VBA
Related
So, I have a worksheet, in which I want to search for a value of Range("M" & i) in Range("A:A"). However, when I try to run this code, it returns an error: "Run-Time Error '91': Object Variable or With block not set. When I click debug, it finds an error on
SearchIn = Range("A:A")
I did google the internet and this site (found something), but I still can't solve the issue. Anyone got a clue?
Sub Find_Replace()
Dim i As Integer
Dim SearchIn As Range
Dim SearchedObject As Range
Dim FinalCell As Range
Dim SumCell As Range
i = 5
SearchIn = Range("A1:A740")
StartSearch = Range("A" & i)
FinalCell = Range("N" & i)
Do While i <= 740
SearchedObject = SearchIn.Find(What:="M" & i, After:=StartSearch, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If SearchedObject.Value = Range("M" & i).Value Then FinalCell = FinalCell.Value + SearchedObject.Offset(0, 5).Value
Loop
End Sub
When assigning a range, you have to use SET
Sub Find_Replace()
Dim i As Integer
Dim SearchIn As Range
Dim SearchedObject As Range
Dim FinalCell As Range
Dim SumCell As Range
i = 5
Set SearchIn = Range("A1:A740")
Set StartSearch = Range("A" & i)
Set FinalCell = Range("N" & i)
Do While i <= 740
Set SearchedObject = SearchIn.Find(What:="M" & i, After:=StartSearch, _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Not SearchedObject Is Nothing Then
If SearchedObject.Value = Range("M" & i).Value Then _
FinalCell.Value = FinalCell.Value + SearchedObject.Offset(0, 5).Value
End If
Loop
End Sub
EDIT: Also it is advisable to use full path else the search will always happen in active sheet
For example
Set SearchIn = Sheets("Sheet1").Range("A1:A740")
Similarly for others.
I have an userform designed with three listbox. The list box are populated from sheets, List_Dev_Red,List_Man_Red,List_SQM_Red. in my userform activate , I get an error "Method or data member" not found in the below line
For xRow = 2 To Last(1, List_Dev_Red.Range("A:A"))
Could any one tel me what could be the reason for this error.
Private Sub UserForm_Activate()
Dim xRow As Integer
Dim yRow As Integer
Dim zrows As Integer
For xRow = 2 To Last(1, List_Dev_Red.Range("A:A"))
With LB1
.AddItem List_Dev_Red.Cells(xRow, 3).Value
If List_Dev_Red.Cells(xRow, 2) = True Then
.Selected(xRow - 2) = True
Else
.Selected(xRow - 2) = False
End If
End With
Next xRow
LB1.Height = (xRow - 1) * 15
For yRow = 2 To Last(1, List_Man_Red.Range("A:A"))
With LB2
.AddItem List_Man_Red.Cells(yRow, 3).Value
If List_Man_Red.Cells(yRow, 2) = True Then
.Selected(yRow - 2) = True
Else
.Selected(yRow - 2) = False
End If
End With
Next yRow
LB2.Height = (yRow - 1) * 15
For zrows = 2 To Last(1, List_SQM_Red.Range("A:A"))
With LB3
.AddItem List_SQM_Red.Cells(zrows, 3).Value
If List_SQM_Red.Cells(zrows, 2) = True Then
.Selected(zrows - 2) = True
Else
.Selected(zrows - 2) = False
End If
End With
Next zrows
LB3.Height = (zrows - 1) * 15
End Sub
Function Last (from RondeBruin):
Function Last(choice As Long, rng As Range)
' 1 = last row
' 2 = last column
' 3 = last cell
Dim lrw As Long
Dim lcol As Long
Select Case choice
Case 1:
On Error Resume Next
Last = rng.Find(What:="*", _
After:=rng.Cells(1), _
LookAt:=xlWhole, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
Case 2:
On Error Resume Next
Last = rng.Find(What:="*", _
After:=rng.Cells(1), _
LookAt:=xlWhole, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
Case 3:
On Error Resume Next
lrw = rng.Find(What:="*", _
After:=rng.Cells(1), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
On Error Resume Next
lcol = rng.Find(What:="*", _
After:=rng.Cells(1), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
On Error Resume Next
Last = rng.Parent.Cells(lrw, lcol).Address(False, False)
If Err.Number > 0 Then
Last = rng.Cells(1).Address(False, False)
Err.Clear
End If
On Error GoTo 0
End Select
End Function
You need to change your syntax a bit (at the upper section of your code):
Dim xRow As Long
Dim yRow As Long
Dim zrows As Long
Dim LastRow As Long ' <-- change all variables to Long (be on the safe side)
' get the last row by calling your Last function
LastRow = Last(1, List_Dev_Red.Range("A:A")) ' <-- you are passing a Range, and want to get a Long, representing the row number
' loop through your rows
For xRow = 2 To LastRow
' rest of your code
Next xRow
and make the change to your Function to return a Long (row number):
Function Last(choice As Long, rng As Range) As Long
In general, concerning that you know that you are looking for either column or row, you may use simplified functions like these:
Option Explicit
Function LastRow(sh As Worksheet) As Long
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
Function LastCol(sh As Worksheet) As Long
On Error Resume Next
LastCol = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
End Function
They are from the same site as the Variant function.
Option Explicit
'***** VARIABLES *****
Public wbI As Workbook, wsChess As Worksheet
Public blackPlayer As cPlayer, whitePlayer As cPlayer
Public txtB_bPlayerName As TextBox, txtB_wPlayerName As TextBox
Public Sub initVars()
Set wbI = ThisWorkbook
Set wsChess = wbI.Sheets(1)
'Works
ThisWorkbook.Sheets(1).txtB_bPlayerName.Value = ""
'Don't work
wsChess.txtB_wPlayerName.Value = ""
End Sub
STILL really bad at vba....
1) I am trying to count the number of overdue tasks. At the moment it is not counting.
2) when i press f5 even though I have erased all the info in the page it goes to the next column
eg If i erased column 1 it will go to column 2 even though there is no info in column 1.
Sub data_input_overdue()
Dim rw As Long
Dim Counter As Long
Dim col As Long
col = CountMyCols("Stats")
Worksheets("Stats").Cells(2, col + 1).Value = "Overdue"
Counter = 0
For Each sht In ThisWorkbook.Sheets
For i = 2 To CountMyRows(sht.Name)
c_date = Range("E" & i)
dueDate = CDate(c_date)
If dueDate < Date And sht.Range("I" & i).Value = "No" Then
Counter = Counter + CLng(1)
Worksheets("Stats").Cells(i, col + 1).Value = Counter
End If
Next i
Next sht
End Sub
Function CountMyCols(SName As String) As Long
CountMyCols = ThisWorkbook.Worksheets(SName).UsedRange.Columns.Count
End Function
A replacement CountMyCols function might be:
Public Function CountMyCols(SName As String) As Long
On Error Resume Next
With ThisWorkbook.Worksheets(SName)
CountMyCols = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
End With
End Function
This has been based on one of the examples in the now-retired StackOverflow Documentation:
Private Sub Get_Last_Used_Row_Index()
Dim wS As Worksheet
Set wS = ThisWorkbook.Sheets("Sheet1")
Debug.Print LastCol_1(wS)
Debug.Print LastCol_0(wS)
End Sub
You can choose between 2 options, regarding if you want to know if there is no data in the worksheet :
NO : Use LastCol_1 : You can use it directly within wS.Cells(...,LastCol_1(wS))
YES : Use LastCol_0 : You need to test if the result you get from the function is 0 or not before using it
Public Function LastCol_1(wS As Worksheet) As Double
With wS
If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
LastCol_1 = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
Else
LastCol_1 = 1
End If
End With
End Function
The Err object's properties are automatically reset to zero upon function exit.
Public Function LastCol_0(wS As Worksheet) As Double
On Error Resume Next
LastCol_0 = wS.Cells.Find(What:="*", _
After:=ws.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
End Function
The Sub written below is designed to open a workbook and copy the sheets into a template, then close the workbook leaving the template open. It works, but there is data until row 19195 but only 12135 rows of data get copied. What is my problem in the Sub?
Sub CopySheetsl()
Dim wb As Workbook, wb1 As Workbook
Dim CopySht As Worksheet
Dim LastRow As Long
Set wb = Workbooks.Open("L:\ABC\test\macro\test.xlsx")
Set wb1 = Workbooks("macro.xlsm")
LastRow = range("A:A").Find("", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
wb1.Sheets("Sheet1").range("A1", "N1" & LastRow) = wb.Sheets("Sheet1").range("A1", "N1" & LastRow).Value
wb1.Sheets("Sheet2").range("C1", "AN1" & LastRow) = wb.Sheets("Sheet2").range("A1", "AL1" & LastRow).Value
wb.Close
End Sub
This isn't finding the last row, it's finding an empty cell.
Dim ws as Worksheet : Set ws = wb1.Sheets("Sheet1")
LastRow = ws.Cells(ws.rows.count, 1).End(xlUp).Row ' last populated row in column A
You'll also need to recalculate it for Sheet2 unless you can be absolutely sure that both sheets have the same number of rows.
From Ron De Bruin's site
Public Function fndLast(choice As Long, rng As Range)
'Ron de Bruin, 5 May 2008
' 1 = last row
' 2 = last column
' 3 = last cell
Dim lrw As Long
Dim lcol As Long
Select Case choice
Case 1:
On Error Resume Next
fndLast = rng.Find(What:="*", _
After:=rng.Cells(1), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
Case 2:
On Error Resume Next
fndLast = rng.Find(What:="*", _
After:=rng.Cells(1), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
Case 3:
On Error Resume Next
lrw = rng.Find(What:="*", _
After:=rng.Cells(1), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
On Error Resume Next
lcol = rng.Find(What:="*", _
After:=rng.Cells(1), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
On Error Resume Next
fndLast = rng.Parent.Cells(lrw, lcol).Address(False, False)
If Err.Number > 0 Then
fndLast = rng.Cells(1).Address(False, False)
Err.Clear
End If
On Error GoTo 0
End Select
End Function
Hello everybody peeps,
I'm extremely new to VB and I've been taking bits of code of the web trying to create something quite simple. I'm trying to get excel to calculate the number of weeks between two cells with date values. The first cell is in a fixed location, the second cell is the last cell within that columns used range.
Last is a function I pinched off the web. I can't get this to work at all, any help would be much appreciated.
Sub test_date_calc()
Dim LastCell As String
Dim nwks As Integer
Dim rng As Range
Set rng = Sheets("data13").UsedRange
LastCell = Last(3, rng)
nwks = (Cells(3, 2) - LastCell.Value) / 7
If nwks > 13 Then
MsgBox "greater"
Else
MsgBox "Less"
End If
End Sub
the Last function below, which may help
Function Last(choice As Long, rng As Range)
'Ron de Bruin, 5 May 2008
' 1 = last row
' 2 = last column
' 3 = last cell
Dim lrw As Long
Dim lcol As Long
Select Case choice
Case 1:
On Error Resume Next
Last = rng.Find(What:="*", _
After:=rng.Cells(1), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
Case 2:
On Error Resume Next
Last = rng.Find(What:="*", _
After:=rng.Cells(1), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
Case 3:
On Error Resume Next
lrw = rng.Find(What:="*", _
After:=rng.Cells(1), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
On Error Resume Next
lcol = rng.Find(What:="*", _
After:=rng.Cells(1), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
On Error Resume Next
Last = rng.Parent.Cells(lrw, lcol).Address(False, False)
If Err.Number > 0 Then
Last = rng.Cells(1).Address(False, False)
Err.Clear
End If
On Error GoTo 0
End Select
End Function
I think your error is due to this line:
nwks = (Cells(3, 2) - LastCell.Value) / 7
LastCell is a string so it doesn't need the .Value
nwks = (Cells(3, 2) - LastCell) / 7
You can use the DATEDIFF function in VBA.
DateDiff( interval, date1, date2, [firstdayofweek], [firstweekofyear] )
Usage example:
nwks = DateDiff("ww", Cells(3, 2).Value, LastCell.Value)
You can see the documentation for DATEDIFF HERE