I have no need to populate the search box when submitting guest check in details, the code i am using is below, is it possible to ad additional code to avoid this error. Thanks in advance!!!!! lblrow.Caption = .Row 'error line
Private Sub Txtforename_Change()
Dim rng As Range
lblrow.Visible = False
With Sheets("Report")
Set rng = Range(.Cells(1, 1), .Cells(1, 1).End(xlDown))
End With
With rng.Find(Txtguestsearch, lookat:=xlWhole)
lblrow.Caption = .Row
End With
End Sub
You need to code for possibility of your value not being found with the Range.Find method.
I also updated your LRow calculation to use the with block and more standard calc
Private Sub Txtforename_Change()
Dim rng As Range, Found as Range
lblrow.Visible = False
With Sheets("Report")
Set rng = .Range("A1:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
End With
Set Found = rng.Find(Txtguestsearch, lookat:=xlWhole)
If Not Found is Nothing Then
With Found
lblrow.Caption = .Row
End With
Else '<--Optional
MsgBox "Not Found" '<--Optional
End If
End Sub
Related
Im at a loss here, why do i get run-time error 91: "object variable or with block variable not set"
What am i doing wrong here and what's the fix?
Thank you in advance!
Set StartCell = Worksheets("Data").Range("A5")
Set StartSheet = Worksheets("Data")
With Worksheets("Data").Range("A4:BZ4")
Set LastColumn = .Find("Comment", LookIn:=xlValues)
Debug.Print StartCell.Row
Debug.Print StartCell.Column
Set Workrange = Range(StartSheet.Cells(StartCell.Row, StartCell.Column), StartSheet.Cells(5000, LastColumn.Column)) 'This line is the issue
End With
If Not Intersect(Target, Workrange) Is Nothing Then
If Target.Count > 1 Then Exit Sub
StartSheet.Cells(Target.Row, LastColumn.Column + 1).Value = Environ("username")
StartSheet.Cells(Target.Row, LastColumn.Column + 2).Value = Format(Now, "dd/mm/yyyy_hh.mm.ss")
End If
End Sub
Issues in your code
Find might not return a hit, test for that
Find uses the last set values for several parameters. Not specifying them can give unexpected results.
Other improvements
If you are going to exit on Target.Count > 1 then just do it
In a Worrksheet code behind module, use Me to refer to that sheet
Dim your variables
Removed redundant With
Cleaned up cumbersome range reference
Private Sub Worksheet_Change(ByVal Target As Range)
Dim StartCell As Range
Dim LastColumn As Range
Dim Workrange As Range
If Target.Count > 1 Then Exit Sub
Set StartCell = Me.Range("A5")
'Debug.Print StartCell.Row
'Debug.Print StartCell.Column
Set LastColumn = Me.Range("A4:BZ4").Find( _
What:="Comment", _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
MatchCase:=False, _
MatchByte:=TRUE) ' only need MatchByte if you have selected or installed double-byte language support.
If Not LastColumn Is Nothing Then
Set Workrange = Me.Range(StartCell, Me.Cells(5000, LastColumn.Column))
If Not Intersect(Target, Workrange) Is Nothing Then
Me.Cells(Target.Row, LastColumn.Column + 1).Value = Environ("username")
Me.Cells(Target.Row, LastColumn.Column + 2).Value = Format$(Now, "dd/mm/yyyy_hh.mm.ss")
End If
End If
End Sub
I've already used Set to create ranges with names in the format rng1a. I then use a loop to go through i (integer) values, and want to set the final range to use to be the one that has the name in the form 'rng' & i & "a"
My initial thought was something along the lines of Range("rng" & i & "a"), however this results in an error.
Set rng1a = Range("B2", Range("B2").End(xlDown))
Set rng2a = Range("D2", Range("E2").End(xlDown))
i = 1
Do
("rng" & i & "a").Copy 'this is the problem
Range("A2").End(xlDown).Offset(1,0).PasteSpecial xlPasteValues
i = i + 1
Loop Until i = 3
I keep getting an error message with
run-time error '1004':
Method 'Range' of object '_Global' failed
My thought is that I need to format the name of the range as a string so that it can be recognised as the name of a range. Is there a way to do this?
I haven't tested either of these, but I think they should work.
Be wary of using End(xldown) as if you don't have anything underneath the first cell you will go straight to the very last cell. Better to work up from the bottom (see Damian's answer).
Sub x1()
'Array
Dim rng(1 To 2) As Range, i As Long
Set rng(1) = Range("B2", Range("B2").End(xlDown))
Set rng(2) = Range("D2", Range("E2").End(xlDown))
For i = 1 To 2
rng(i).Copy
Range("A2").End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues
Next i
End Sub
Sub x2()
'Named ranges
Dim i As Long
Range("B2", Range("B2").End(xlDown)).Name = "rng1a"
Range("D2", Range("E2").End(xlDown)).Name = "rng2a"
For i = 1 To 2
Range("rng" & i & "a").Copy
Range("A2").End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues
Next i
End Sub
This should do it:
Option Explicit
Sub Test()
Dim i As Long, LastRow As Long
Dim arrRanges(1 To 2) As Range
With ThisWorkbook.Sheets("NameYourSheet") 'change the sheet name
Set arrRanges(1) = .Range("B2", .Range("B2").End(xlDown))
Set arrRanges(2) = .Range("D2", .Range("E2").End(xlDown))
For i = LBound(arrRanges) To UBound(arrRanges)
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
arrRanges(i).Copy .Range("A" & LastRow)
Next i
End With
End Sub
Remember to always declare all your variables, and reference to workbooks and worksheets.
What you actually want to do (I think) is copy the contents of the columns B,C D etc, into Column A underneath each other.
Sub CopyStuff
Dim i as integer
dim r as range
for i = 1 to 6
set r = range(cells(1,i),cells(1,i).end(xldown))
r.copy
range("a1").end(xldown).offset(1,0).pastespecial xlpastevalues
next i
End sub
You can have array of ranges :
Set rng1a = Range("B2", Range("B2").End(xlDown))
Set rng2a = Range("D2", Range("E2").End(xlDown))
For Each rng in Array(rng1a, rng2a)
rng.Copy
Range("A2").End(xlDown).Offset(1,0).PasteSpecial xlPasteValues
Next
I have some data that has both words and values in cells and I am trying to delete the rows that don’t have values in the cells. My code works now if all of the numbers are negative but if there are positive numbers then my code won’t work. How do I fix this?
Sub tval
Dim s As Long
Dim LastRow As Long
S=2
LastRow= cells.find(“*”,[A1],,, xlByRows,xlPreviousRow).row
Do until s>LastRow
DoEvents
If InStr(1,Cells(s,4), “-“) > 0 Then
S=s+1
Else
Cells(s,4).EntireRow.Delete
LastRow=LastRow -1
End if
Loop
End sub
When deleting rows, you should always start from the end.
Sub tval
Dim s As Long
Dim LastRow As Long
LastRow= Cells(Rows.Count, 1).End(xlUp).Row
For s= LastRow to 2 Step -1
If Not IsNumeric(Cells(s,4)) then
Cells(s,4).EntireRow.Delete
End if
Next s
End sub
This should work for you:
Sub tgr()
Dim ws As Worksheet
Dim rTextConstants As Range
Dim rTextFormulas As Range
Dim rCombined As Range
Set ws = ActiveWorkbook.ActiveSheet
'Exclude row 1 so that only text values found in rows 2+ are found
With ws.Range("A2", ws.Cells(ws.Rows.Count, ws.Columns.Count))
On Error Resume Next 'prevent error if no cells found
Set rTextConstants = .SpecialCells(xlCellTypeConstants, xlTextValues)
Set rTextFormulas = .SpecialCells(xlCellTypeFormulas, xlTextValues)
On Error GoTo 0 'remove on error resume next condition
End With
If Not rTextConstants Is Nothing Then Set rCombined = rTextConstants
If Not rTextFormulas Is Nothing Then
If rCombined Is Nothing Then Set rCombined = rTextFormulas Else Set rCombined = Union(rCombined, rTextFormulas)
End If
If Not rCombined Is Nothing Then
rCombined.EntireRow.Delete
Else
MsgBox "No cells containing text found in sheet '" & ws.Name & "'", , "Error"
End If
End Sub
May I suggest a bit of a different approach:
Before:
Code:
Dim RNG1 As Range, RNG2 As Range
Option Explicit
Sub TestCase()
With ActiveWorkbook.Sheets(1)
Set RNG1 = .Range("A1:A" & .Cells(Rows.Count, 1).End(xlUp).Row)
If RNG1.SpecialCells(xlCellTypeConstants, 1).Count <> RNG1.Cells.Count Then
Set RNG2 = Application.Intersect(RNG1, RNG1.SpecialCells(xlCellTypeConstants, 2))
RNG2.EntireRow.Delete
End If
End With
End Sub
After:
You'll need to change this around to suit your range obviously. It should be a good starting point nonetheless.
You can also use AutoFilter to filter the numbers, and delete the visible cells to accomplish this task. The code accounts for a header row.
With ThisWorkbook.Sheets("Sheet1")
With .Range("A1").CurrentRegion
.AutoFilter
.AutoFilter Field:=4, Criteria1:="<>*"
.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
.AutoFilter
End With
End With
I am getting a run time error on the below code , can you please assist.
The part and getting the error on is rngRange.Select. Can you advise in any way in which i can amend the below code? Thank you in advance
Sub NameRangeTop(Optional ByRef rngRange As Range)
If rngRange Is Nothing Then
Set rngRange = Application.Selection
Else
rngRange.Select
End If
Dim ActiveRange As Range
Dim NumRows, NumColumns, iCount As Long
Dim CurSheetName As String
CurSheetName = ActiveSheet.Name
Set ActiveRange = Selection.CurrentRegion
ActiveRange.Select
NumRows = ActiveRange.Rows.Count
NumColumns = ActiveRange.Columns.Count
If NumRows = 1 And NumColumns = 1 Then
MsgBox "No active cells in the surrounding area. Try running the macro from a different location", vbCritical, "Local Range Naming"
Exit Sub
End If
If NumRows = 1 Then
Set ActiveRange = ActiveRange.Resize(2)
NumRows = 2
End If
For iCount = 1 To NumColumns
ActiveRange.Resize(NumRows - 1).Offset(1, 0).Columns(iCount).Name = CurSheetName & "!" & ActiveRange.Rows(1).Columns(iCount).Value
Next
ActiveRange.Resize(NumRows - 1).Offset(1, 0).Select
End Sub
it's because the passed rngRangerange doesn't belong to currently active worksheet
code like this
If rngRange Is Nothing Then
Set rngRange = Application.Selection
Else
rngRange.Parent.Activate
rngRange.Select
End If
All,
I am receiving the error "Application defined or object defined error" for a private sub that I have written. The code is below:
Private Sub CommandButton3_Click()
Dim MyLastRow As Long
Dim i As Long
Dim cellmatch
'Find the last row
MyLastRow = Cells(Rows.Count, "A").End(xlUp).Row
'Define our comparison
cellmatch = Application.Match(Cells(i, "A").Value, Range(Cells(i, "C")).Value, 0)
'Compare Raw Data cell to Stock column and find a match
For i = 2 To MyLastRow
If IsError(cellmatch) Then
Cells(i, 2) = "Not in Stock"
Else
Cells(i, 2) = "-"
End If
Next i
End Sub
I have tried several things I found on the forums such us specifying the worksheet
Application.WorksheetFuncion.Match.....
I've also tried point to the cell or range such as:
Range(.Cells(i,"C"))....
or
.Match(.Cells(i,"A"))...
But I keep getting the same error. All of this is happening on the same sheet and I'm not trying to do anything fancy like copying. I am simply asking if a match is NOT found, then label as such, else, label it with a dash (done like this for clarity). I am sure it's something very simple but I am new to coding in VBA. Any help is much appreciated.
Thanks!
Your code requires change of this code line.
cellmatch = Application.Match(Cells(i, "A").Value, Range(Cells(i, "C")).Value, 0)
TO
'Adjust Sheetname as per your requirements instead of "Sheet1"
cellmatch = Application.Match(Cells(i, "A").Value, Worksheets("Sheet1").Columns(3), 0)
EDIT
Main problem is coming in your program because of the following code fragment.
Range(Cells(i, "C")).Value
If we refer to MSDN Documenation
Range.Cells Property (Excel)
It mentions exammples of correct syntax of usage.
Typical example is
Set r = Range("myRange")
For n = 1 To r.Rows.Count
If r.Cells(n, 1) = r.Cells(n + 1, 1) Then
MsgBox "Duplicate data in " & r.Cells(n + 1, 1).Address
End If
Next n
So it translates to Range("myRange").Cells(n,1)
and not
Range(Cells(i, "C"))
It will give correct results as shown in the snapshot.
I believe this is what you are looking for:
Option Explicit
Private Sub CommandButton3_Click()
Dim lngRow As Long
Dim rngFound As Range
Dim lngLastRow As Long
Dim shtCurrent As Worksheet
'Set the sheet to work on
Set shtCurrent = ThisWorkbook.Worksheets("Sheet1")
With shtCurrent
'Find the last row
lngLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
'Exit if the last row is 2 or smaller
If lngLastRow <= 2 Then
MsgBox "Nothing to compare!" & Chr(10) & "Aborting..."
Exit Sub
End If
'Compare Raw Data cell to Stock column and find a match
For lngRow = 2 To lngLastRow
'Only compare if there is something in column A to compare
If .Cells(lngRow, "A").Value2 <> vbNullString Then
'This is the actual MATCH / FIND
Set rngFound = .Range("C:C").Find(What:=.Cells(lngRow, "A").Value2, LookIn:=xlValues, LookAt:=xlWhole)
'Evaluate the result of the FIND = rngFound
If rngFound Is Nothing Then
.Cells(lngRow, 2).Value2 = "Not in Stock" 'not found
Else
.Cells(lngRow, 2).Value2 = "In stock in row " & rngFound.Row 'found
End If
End If
Next lngRow
End With
End Sub
Let me know if you have and problems / questions.