My code is supposed to check each column "C" cell for whatever input is in TextBox2 then, if found, using the row found in adjust the Column "D" intersected cell contents to "IN".
All this is happening as desired with one exception. If I click the command button "Check IN" with no input in textbox2, it sets the first next empty cell in column "D" as "IN".
Private Sub CheckIn_Click()
Dim FoundRange As Range
Dim Status As Range
Set FoundRange = Columns("C").Find(What:=TextBox2.Text, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
If Not FoundRange Is Nothing Then
Set Status = FoundRange.Offset(ColumnOffset:=1)
Status.Value = "IN"
TextBox2 = ""
ThisWorkbook.Save
Else
Status.Value = ""
TextBox2 = ""
TextBox1.SetFocus
MsgBox "Not Found"
End If
End Sub
What I attempted to do is use the same script from line 9 at line 13 but with an empty value so that even if something is done the cell is empty. On the other hand, after running the code without TextBox2 input I received this error:"Object variable or With block variable not set" at line 13.
I do not understand what variable is not being set. All I am trying to do is mitigate what happens if the button is hit with no input.
Test First:
Private Sub CheckIn_Click()
Dim FoundRange As Range
Dim Status As Range
If TextBox2.Text = "" Then
MsgBox "Test Skipped"
Else
Set FoundRange = Columns("C").Find(What:=TextBox2.Text, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
If Not FoundRange Is Nothing Then
Set Status = FoundRange.Offset(ColumnOffset:=1)
Status.Value = "IN"
TextBox2 = ""
ThisWorkbook.Save
Else
Status.Value = ""
TextBox2 = ""
TextBox1.SetFocus
MsgBox "Not Found"
End If
End If
End Sub
First check the value of TextBox2, then proceed if there is a value.
Private Sub CheckIn_Click()
If TextBox2.Value <> "" Then
Dim FoundRange As Range
Dim Status As Range
Set FoundRange = Columns("C").Find(What:=TextBox2.Text, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
If Not FoundRange Is Nothing Then
Set Status = FoundRange.Offset(ColumnOffset:=1)
Status.Value = "IN"
TextBox2.Value = ""
Else
MsgBox "Not Found"
End If
End If
End Sub
Related
Ok so here is my VBA:
Private Sub In_Click()
Range("E2").Find.Text = TextBox1.Text And TextBox2.Text
Range("A65536").End(xlUp).Select
RowNumber = ActiveCell.Row
Range("E(RowNumber)") = ("IN")
End Sub
What I am trying to make happen is, the contents of form TextBox1 and 2 are searched for and, if found, a cell in column E of whatever row the text was found (Will be the same row for both) in will be overwritten to read "IN" and the form cleared for the next entry.
If down voting or flagging in some way please tell me why at least. I cant do better if I dont know the problem.
New:
Private Sub CheckIn_Click()
Dim FoundRange As Range
Dim Status As Range
Set FoundRange = Columns("D").Find(What:=TextBox2.Text, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
If Not FoundRange Is Nothing Then
Set Status = Columns("E")
Status.Value = "IN"
Else
MsgBox "Not Found"
End If
End Sub
You would use either the Range.Find method to find the first occurrence …
Sub In_Click()
Dim FoundRange As Range
Set FoundRange = Columns("E").Find(What:=TextBox1.Text & TextBox2.Text, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
If Not FoundRange Is Nothing Then
FoundRange.Value = "IN"
Else
MsgBox "not found"
End If
End Sub
Or the Range.Replace method to replace all occurences …
Sub In_Replace()
Columns("E").Replace What:=TextBox1.Text & TextBox2.Text, Replacement:="IN", LookAt:=xlWhole, MatchCase:=False
End Sub
Note that if you concatenate 2 strings you must use the & and you cannot use the word And: ConcatString = TextBox1.Text & TextBox2.Text.
I am currently writing a jumble of excel code to track a number, items and dates and staff members.
I got to a point where I do a search using a cbobox and variant of letters or names to gather data and place it into a list box showing headers and columns
via the Name Manager i have set up: =OFFSET(NEW_IBO_Tracker!$AA$9,0,0,COUNTA(NEW_IBO_Tracker!$AA$9:$AA$9000),15).
I have set up a basic code to test this and it works. It searches the main data, gathers the (selected search variable eg "an"), then makes a copy of all the names that contain "an" places this into the offset location.
The issue that I am having is that the main code is NOT doing the above
Private Sub cmdGetData_Click()
Dim Crit As Range
Dim FindMe As Range
Dim DataSH As Worksheet
Set DataSH = Sheet4
On Error GoTo errHandler:
Application.ScreenUpdating = False
'///////////////////////////////////////////
'if header is selected add the criteria
If Me.cboHeader.Value <> "All_Columns" Then
If Me.txtSearch = "" Then
DataSH.Range("Y9") = ""
Else
DataSH.Range("Y9") = "*" & Me.txtSearch.Value & "*"
End If
End If
'///////////////////////////////////////////
'If all columns is selected
If Me.cboHeader.Value = "All_Columns" Then
'find the value in the column
Set FindMe = DataSH.Range("B9:O100000").Find(What:=txtSearch, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
'variable for criteria header
Set Crit = DataSH.Cells(8, FindMe.Column)
'if no criteria is added to the search
If Me.txtSearch = "" Then
DataSH.Range("Y9") = ""
DataSH.Range("Y8") = ""
Else
'add values from the search
DataSH.Range("Y8") = Crit
If Crit = "ID" Then
DataSH.Range("Y9") = Me.txtSearch.Value
Else
DataSH.Range("Y9") = "*" & Me.txtSearch.Value & "*"
End If
'show in the userform the header that is added
Me.txtAllColumn = DataSH.Range("Y8").Value
End If
End If
'/////////////////////////////////////////
'unprotect all sheets
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''Unprotect_All
'Filter the data
DataSH.Range("B8").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("NEW_IBO_Tracker!$Y$8:$Y$9"), CopyToRange:=Range("NEW_IBO_Tracker!$AA$8:$AO$8"), _
Unique:=False
'add the dynamic data to the listbox
lstData.RowSource = DataSH.Range("outdata").Address(external:=True)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''Protect_All
'error handler
On Error GoTo 0
Exit Sub
errHandler:
'''''''''''''''''''''''''''''''''''''''''''''''''''''Protect all sheets
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''Protect_All
'If error occurs then show me exactly where the error occurs
MsgBox "No match found for: " & txtSearch.Text
'clear the listbox if no match is found
Me.lstData.RowSource = ""
Exit Sub
End Sub
I am willing to send the workbook if anyone thinks it would be easier. I have spent about a week trying to get this little bit to work and it's driving me insane OHH YAY!!
Thanks heaps in advance
When .Find does not find a result, I want an error msg. I have used the method that is almost universally recommended online, but it is not working. When a value is not found, nothing happens. There should be a msg box identified the error.
If Not rFoundCell Is Nothing Then
MsgBox "val: " & rValue.Value & " Matching Cell: " & rFoundCell.Address
Cells(Range(rFoundCell.Address).Row, Range(rFoundCell.Address).Column).Select
Else
MsgBox (rValue.Value & " not found.")
GoTo end_search
End If
I've tried the other way as well:
If rFoundCell Is Nothing Then
Display a msg "not found"
else
Keep going.
That didn't work either. What am i missing?
Full code follows:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim PostRng As Range
Dim PendRng As Range
Dim rValue As Range
Dim lLoop As Long
Dim rFoundCell As Range
Dim INTRng As Range
Set PostRng = Range("g:g")
Set PendRng = Range("k:k")
'"Intersect" will ensure your current cell lies on correct column.
Set INTRng = Intersect(Target, PostRng)
'IF conditions to trigger code.
'This IF confirms only one cell changed. -- I think
If Target.Columns.Count = 1 And Target.Rows.Count = 1 Then
If Not INTRng Is Nothing And LCase(Target.Text) = "y" Then
'This block will return the range & value on the row where "y" or "Y" are entered.
Set rValue = Target.Offset(0, -3) 'Returns value in Col D
If rValue = 0 Or rValue = "" Then Set rValue = Target.Offset(0, -2)
Debug.Print "Target "; Target
Debug.Print "rvalue.value "; rValue.Value
'This will loop through a different column, to find the value identified above, and return its cell address in the other column.
With PendRng
Set rFoundCell = .Cells(1, 1)
For lLoop = 1 To WorksheetFunction.CountIf(.Cells, rValue.Value)
Set rFoundCell = .Find(What:=rValue.Value, _
After:=rFoundCell, _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
Debug.Print "rfoundcell " & rFoundCell
If Not rFoundCell Is Nothing Then
MsgBox "val: " & rValue.Value & " Matching Cell: " & rFoundCell.Address
'This will use the cell address identified above to move the active cell to that address.
'Have to convert the address to row/column to use in Cell.Select.
Cells(Range(rFoundCell.Address).Row, Range(rFoundCell.Address).Column).Select
Else
MsgBox (rValue.Value & " not found.")
GoTo end_search
End If
Next lLoop
End With
End If
End If
end_search:
End Sub
Received help w/ this code here:
Execute a subroutine when a user enters a trigger into a cell
I believe that your code is skipping the If statement that generates the error box if there is not a match.
This is due to For lLoop = 1 To WorksheetFunction.CountIf(.Cells, rValue.Value) exiting when there is no matches because it equates to For lLoop = 1 To 0
I moved all of your error message code into an If statement above the lLoop as follows:
If WorksheetFunction.CountIf(.Cells, rValue.Value) = 0 Then
MsgBox (rValue.Value & " not found.")
GoTo end_search
End If
I'm trying to set a variable based on the value I find, however VB produces "Compile error: invalid identifier", and highlights my variables. I will post code below and identify the line where the error is being produced.
What the code does:
a) Asks user to input start & end dates in the format week/year
b) If the user does that the code will find the specified value in the range and take the value which is 4 rows below that value.
That's it - pretty simple & straightforward...
Private Sub Workbook_Open()
Dim ans As Variant, stDt As Variant, endDt As Variant, endCl As Variant, stCl As Variant, wsheet As Worksheet, wbook As Workbook, _
fn_stDt As Variant, wk As Integer, rl_st_Dt As String, rl_end_Dt As String, fn_endDt As Variant
Set wbook = Workbooks("wbook1.xlsm")
Set wsheet = wbook.Worksheets("sheet1")
ans = MsgBox("Would you like to specify the range of dates now?", vbYesNo, "Select answer")
If ans = vbYes Then
stDt = Application.InputBox("Please input the starting date", "Start week for forecast / sales", "ww/yyyy", vbOKCancel, vbQuestion)
If stCl = vbCancel Then
Exit Sub
End If
endDt = Application.InputBox("Please input the end date", "End week for forecast / sales", "ww/yyyy", vbOKCancel, vbQuestion)
If endCl = vbCancel Then
Exit Sub
End If
Else
Exit Sub
End If
With wsheet.Range("S5", Range("S5").End(xlToRight))
Set fn_stDt = .Find(what:=stDt, LookIn:=xlValues, searchorder:=xlByRows, _
searchdirection:=xlNext, MatchCase:=False, searchformat:=False)
If Not fn_stDt Is Nothing Then
wk = fn_stDt.Offset(-2, 0).Value
If wk.Value <> wk.Offset(0, 1).Value Then 'Compile Error: Invalid qualifier error appears first here and highlights "wk"
rl_st_Dt.Value = wk.Offset(-4, 0).Value
ElseIf wk.Value = wk.Offset(0, 1) Then
rl_st_Dt.Value = wk.Offset(-4, 1).Value
End If
End If
End With
With wsheet.Range("S5", Range("S5").End(xlToRight))
Set fn_endDt = .Find(what:=endDt, LookIn:=xlValues, searchorder:=xlByRows, _
searchdirection:=xlNext, MatchCase:=False, searchformat:=False)
If Not fn_endDt Is Nothing Then
wk.Value = fn_endDt.Offset(-2, 0).Value
If wk.Value <> wk.Offset(0, 1).Value Then
rl_end_Dt.Value = wk.Offset(-4, 0).Value
ElseIf wk.Value = wk.Offset(0, 1).Value Then
rl_end_Dt.Value = wk.Offset(-4, 1).Value
End If
End If
End With
End Sub
Could anyone please propose a resolution to the above?
Thanks
I have some VBA experience, I can read and understand the coding, but have problems finding the proper codes.
Now, I have a userform where by the user would key in his ID, excel would then open up the database and search and return the results of the cells beside the found ID. the results would be returned and overwrite label 1 and label 2. And when the user clicks on the "next" or "previous" button, the next or previous results would then overwrite both labels.
The code I have right now allows me to search for the locations of the found ID and output the location in a format such as ($A$2,$A$3,$A$4,$A$6). The problem is that I am not sure what is the right functions that can then break this into individual range that the "next" or "previous" button can then refer to.
Have added my code
Dim cell As Range
Dim bcell As Range
Dim foundat As String
Dim oRange As Range
Dim userid As String
Dim x As Long
Dim y As Long
Dim Prob As String
Dim ws As Worksheet
Set ws = Worksheets("OFI")
Set oRange = ws.Columns(1)
userid = txt_user.Text
Set cell = oRange.Find(what:=userid, after:=Range("A1"), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, searchdirection:=xlNext, MatchCase:=False)
If Not cell Is Nothing Then
Set bcell = cell
foundat = cell.Address
Do
Set cell = oRange.FindNext(after:=cell)
If Not cell Is Nothing Then
If cell.Address = bcell.Address Then Exit Do
foundat = foundat & ", " & cell.Address
Else
Exit Do
End If
Loop
Else
msgbox userid & "not found"
Exit Sub
End If
capproblem_output.Caption = foundat
Exit Sub
You need to add two command buttons with name cmdNext & cmdPrev , label with name capproblem_output2 to run the below code. Copy the code to userform code section.
Public foundat As String
Private Sub cmdNext_Click()
capproblem_output.Caption = ActiveCell.Offset(1, 1)
capproblem_output2.Caption = ActiveCell.Offset(1, 1)
ActiveCell.Offset(1, 0).Select
End Sub
Private Sub cmdPrev_Click()
capproblem_output.Caption = ActiveCell.Offset(-1, 1)
capproblem_output2.Caption = ActiveCell.Offset(-1, 1)
ActiveCell.Offset(-1, 0).Select
End Sub
Private Sub CommandButton1_Click()
Main
End Sub
Sub Main()
Dim cell As Range
Dim bcell As Range
Dim oRange As Range
Dim userid As String
Dim x As Long
Dim y As Long
Dim Prob As String
Dim ws As Worksheet
Set ws = Worksheets("OFI")
Set oRange = ws.Columns(1)
userid = UserForm1.txt_user.Text
Set cell = oRange.Find(what:=userid, after:=Range("A1"), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, searchdirection:=xlNext, MatchCase:=False)
If Not cell Is Nothing Then
Set bcell = cell
foundat = cell.Address
Do
Set cell = oRange.FindNext(after:=cell)
If Not cell Is Nothing Then
If cell.Address = bcell.Address Then Exit Do
foundat = foundat & ", " & cell.Address
Else
Exit Do
End If
Loop
Else
MsgBox userid & "not found"
Exit Sub
End If
capproblem_output.Caption = Range(foundat).Offset(0, 1)
capproblem_output2.Caption = Range(foundat).Offset(0, 1)
End Sub