This might be a very dumm question. I would like to point out that I am pretty new to VBA.
By looking in the internet here and there, I managed to create the following code, which I use to highlight all the cells containing a certain date. I would like now to tweak my code and extend the highlighnt to the rows of the cell containing a certain date, so that later I could easily copy and past them into a new tab.
Sub HighlightSpecificValue()
Dim fnd As String, FirstFound As String
Dim FoundDate As Range, rng As Range
Dim myRange As Range, LastCell As Range
Dim datetoFind As Date
'Value to be found
fnd = InputBox("Emter the date to be found", "Highlight")
'End Macro if Cancel Button is Clicked or no Text is Entered
If fnd = vbNullString Then Exit Sub
'Convert String value to date format
datetoFind = DateValue(fnd)
Set myRange = Sheets("Tabelle1").Range("E:E")
Set LastCell = myRange.Cells(myRange.Cells.Count)
Set FoundDate = myRange.Find(what:=datetoFind, _
after:=LastCell, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
'Test to see if anything was found
If Not FoundDate Is Nothing Then
FirstFound = FoundDate.Address
Else
GoTo NothingFound
End If
Set rng = FoundDate
'Loop until cycled through all unique finds
Do Until FoundDate Is Nothing
'Find next cell with fnd value
Set FoundDate = myRange.FindNext(after:=FoundDate)
'Add found cell to rng range variable
Set rng = Union(rng, FoundDate)
'Test to see if cycled through to first found cell
If FoundDate.Address = FirstFound Then Exit Do
Loop
'Highlight Found cells yellow
rng.Interior.Color = RGB(255, 255, 0)
'Report Out Message
MsgBox rng.Cells.Count & " cell(s) were found containing: " & fnd
Exit Sub
'Error Handler
NothingFound:
MsgBox "No cells containing: " & fnd & " were found in this worksheet"
End Sub
Thanks in advance for your precious help!
Use the EntireRow method of the Range object.
rng.EntireRow.Interior.Color = RGB(255, 255, 0)
Related
I've got a macro code to highlight cells in a sheet where the value comes from another sheet upon a button click on a separate sheet but it is returning value can't be found/none found when the value on both sheets is actually the same.
The value of the cell is a date value.
the 1st is the intended sheet and the 2nd one is the code
intended sheet to highlight cells
Sub HighlightSpecificValue()
Dim fnd As String, FirstFound As String
Dim FoundCell As Range, rng As Range
Dim myRange As Range, LastCell As Range
fnd = Range("H9").Value
Sheets("PO copy").Select
Set myRange = ActiveSheet.UsedRange
Set LastCell = myRange.Cells(myRange.Cells.Count)
Set FoundCell = myRange.Find(what:=fnd, after:=LastCell)
If Not FoundCell Is Nothing Then
FirstFound = FoundCell.Address
Else
GoTo NothingFound
End If
Set rng = FoundCell
Do Until FoundCell Is Nothing
Set FoundCell = myRange.FindNext(after:=FoundCell)
Set rng = Union(rng, FoundCell)
If FoundCell.Address = FirstFound Then Exit Do
Loop
rng.Interior.Color = RGB(255, 255, 0)
Exit Sub
NothingFound:
MsgBox "No cells containing: " & fnd & " were found in this worksheet"
End Sub
A couple of things need to be fixed:
You shouldn't try to compare a String to a cell containing a date - so it will be best to define fnd as a Variant
You are currently not specifying whether to look at values or formulas when doing the Find, or whether to look at part or the whole of the value - you should explicitly define those in order to avoid confusion due to Excel using whatever the user last used
I believe the following, slightly modified, code should work:
Sub HighlightSpecificValue()
Dim fnd As Variant, FirstFound As String
Dim FoundCell As Range, rng As Range
Dim myRange As Range, LastCell As Range
fnd = Range("H9").Value
Sheets("PO copy").Select
Set myRange = ActiveSheet.UsedRange
Set LastCell = myRange.Cells(myRange.Cells.Count)
Set FoundCell = myRange.Find(what:=fnd, _
after:=LastCell, _
LookIn:=xlValues, _
LookAt:=xlWhole)
If Not FoundCell Is Nothing Then
FirstFound = FoundCell.Address
Else
GoTo NothingFound
End If
Set rng = FoundCell
Do Until FoundCell Is Nothing
Set FoundCell = myRange.FindNext(after:=FoundCell)
Set rng = Union(rng, FoundCell)
If FoundCell.Address = FirstFound Then Exit Do
Loop
rng.Interior.Color = RGB(255, 255, 0)
Exit Sub
NothingFound:
MsgBox "No cells containing: " & fnd & " were found in this worksheet"
End Sub
I would like to find a cell in a worksheet containing a specific string.
I won't know precisely how many columns or rows there will be in the spreadsheet, hence why I wanted to do it with CurrentRegion.
This is what I was trying:
=FIND("Data String", Range("A1").CurrentRegion)
You should have a look into the Microsoft References: Range.Find Method (Excel).
.Find(What, After, LookIn, LookAt, SearchOrder, SearchDirection, MatchCase, MatchByte, SearchFormat)
Example:
Dim rngFound as Range
With Worksheets("MySheetName").Cells
Set rngFound = .Find("MySearchString", LookIn:=xlValues)
If Not rngFound Is Nothing Then
'something is found
else
'nothing found
End If
End With
searches the whole sheet
Try This
FindString = Sheets("Sheet1").Range("D1").Value
---------- This will select the next Cell in range with the inputbox value
Sub Find_First()
Dim FindString As String
Dim Rng As Range
FindString = InputBox("Enter a Search value")
If Trim(FindString) <> "" Then
With Sheets("Sheet1").Range("A:A")
Set Rng = .Find(What:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
Application.Goto Rng, True
Else
MsgBox "Nothing found"
End If
End With
End If
End Sub
Find Value
I am putting together a attendance sheet for my workplace. Its going to be partly automated, when a user enters his phone number in the input box his attendance is marked for the day, there is also a input box for the date i.e. just the date not month and year.
Structure of the excel sheet: 2 columns have name and phone number respectively and rest are 1-31 days of the month.
so when a user enter a phone number and date a P (for present) appears under the date column in the same row as the phone number.
Problem : the cell that is being selected by the code is the header which has the dates from 1-31
where am i going wrong?
Please Help.
Thank You
Sub Find_mobilenumber()
Dim FindString As String
Dim FindString1 As String
Dim Rng As Range
FindString = InputBox("Enter Your Mobile Number")
FindString1 = InputBox("Enter todays Date - e.g 21 for 21/03/2015")
If Trim(FindString) <> "" Then
If Trim(FindString1) <> "" Then
With Sheets("Sheet1").Range("D:D") 'searches all of column D
With Sheets("Sheet1").Range("7:7") 'searches all of column 7
Set Rng = .Find(What:=FindString1, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
Application.Goto Rng, True 'value found
If Cell.Value = FindString Goto
MsgBox "Client Checked In"
Else
MsgBox "Client Not Registered" 'value not found
End If
End With
End With
End If
End If
End Sub
Rather than nesting With...End With statements, you can break the search into two easier-to-describe steps: (1) Finding the appropriate row, and (2) Finding the appropriate column. Let's say your design looks like this:
You could adjust your script to populate the "Present" table like so:
Option Explicit
Public Sub Find_mobilenumber()
Dim strMobileNumber As String, strDayOfMonth As String
Dim rngMobileNumbers As Range, rngDaysOfMonth As Range, rng As Range
Dim lngTargetRow As Long, lngTargetCol As Long
Dim wks As Worksheet
'Set references
Set wks = ThisWorkbook.Worksheets("Sheet1")
'Collect mobile number and day of month from user
strMobileNumber = CStr(InputBox("Enter Your Mobile Number"))
strDayOfMonth = CStr(InputBox("Enter todays Date - e.g 21 for 21/03/2015"))
'Stop the script if input is blank
If Trim(strMobileNumber) = "" Or Trim(strDayOfMonth) = "" Then
Call ClientNotRegistered
Exit Sub
End If
'Find the appropriate row by matching mobile number
Set rngMobileNumbers = wks.Range("D:D")
Set rng = rngMobileNumbers.Find(What:=strMobileNumber, LookAt:=xlWhole)
If rng Is Nothing Then
Call ClientNotRegistered
Exit Sub
End If
lngTargetRow = rng.Row
'Find the appropriate column by matching day of month number
Set rngDaysOfMonth = wks.Range("7:7")
Set rng = rngDaysOfMonth.Find(What:=strDayOfMonth, LookAt:=xlWhole)
If rng Is Nothing Then
Call ClientNotRegistered
Exit Sub
End If
lngTargetCol = rng.Column
'Write a "P" in the resulting cell
wks.Cells(lngTargetRow, lngTargetCol) = "P"
MsgBox "Client Checked In"
End Sub
'DRY solution for not found
Public Sub ClientNotRegistered()
MsgBox "Client Not Registered"
End Sub
You start a With block here, but do nothing with it
With Sheets("Sheet1").Range("D:D")
I presume this is where you meant to check the D column for mobile numbers?
How about this revision?
Sub Find_mobilenumber()
Dim FindString As String
Dim FindString1 As String
Dim PhoneRng As Range
Dim Rng As Range
FindString = InputBox("Enter Your Mobile Number")
FindString1 = InputBox("Enter todays Date - e.g 21 for 21/03/2015")
If Trim(FindString) <> "" Then
If Trim(FindString1) <> "" Then
With Sheets("Sheet1").Range("D:D") 'searches for phone no in column D
Set PhoneRng = .Find(What:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
End With
With Sheets("Sheet1").Range("7:7") 'searches all of column 7
Set Rng = .Find(What:=FindString1, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
End With
On Error GoTo ErrorHandler
Intersect(Rng.EntireColumn, PhoneRng.EntireRow).Value = "P"
MsgBox ("Client Checked In")
End If
End If
Exit Sub
ErrorHandler:
MsgBox ("Client Not Registered")
End Sub
I wrote an Excel macro and it seems to work fine. It displays an inputbox and once I give the value in it. It saves that value into first cell of column C (C1). However the second time I run macro I want it to be written into C2 and keep all datas in different rows in column C but each time, it writes it into C1 and cause a data loss.
Sub DataInput()
Dim SearchTarget As String
Dim myRow As Long
Dim Rng As Range
Static PrevCell As Range
Dim FoundCell As Range
Dim CurCell As Range
Dim a As String
Dim Target As Range
'SearchTarget = "asdf"
SearchTarget = InputBox("Scan or type product barcode...", "New State Entry")
If PrevCell Is Nothing Then
myRow = Selection.Row
Set PrevCell = Range("C" & myRow)
End If
'Set Rng = Range("C:C,E:E") 'Columns for search defined here
Set Rng = Range("C:C,C:C") 'Columns for search defined here
With Rng
Set FoundCell = .Cells.Find(What:=SearchTarget, _
After:=PrevCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=True)
End With
If FoundCell Is Nothing Then
MsgBox SearchTarget & " was not found."
Range("C1").Value = InputBox("code?")
Range("D1").Value = Now()
Else
FoundCell.Activate
' If PrevCell.Address = FoundCell.Address Then
' MsgBox "there's only one!"
' End If
ActiveCell.Offset(0, 1).Select
timestamp = Format(Now(), "dd-mmm-yy hh:mm")
ActiveCell = timestamp
ActiveCell = Now()
ActiveCell.Offset(0, 2).Select
ActiveCell = "T141000"
ActiveCell.Offset(0, 1).Select
Set PrevCell = FoundCell
End If
End Sub
The problem here lies in your if statement - you are always storing the newly entered codes in cells C1 and the date in D1. You need to dynamically work out the next available row number and use that instead. Try something like this:
Public Sub DataInput()
...
If FoundCell Is Nothing Then
MsgBox SearchTarget & " was not found."
Dim nextFreeRow As Integer
nextFreeRow = Range("C" & Rows.Count).End(xlUp).Row + 1
Range("C" & nextFreeRow).Value = InputBox("code?")
Range("D" & nextFreeRow).Value = Now()
Else
...
End If
...
End Sub
Here's my code:
Option Explicit
Private Sub CBu_Login_Click()
Dim ws As Worksheet, rng As Range, lrow As Long, find_value As String
Dim cel As Range
Set ws = ThisWorkbook.Sheets("UserName")
lrow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
Set rng = ws.Range("A2:A" & lrow)
find_value = Me.TB_Username.Value
Set cel = rng.Find(What:=find_value, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not cel Is Nothing Then
If Me.TB_Password.Value = cel.Offset(0, 1).Value Then
UF_Encoding.L_User.Caption = "Welcome " & cel.Offset(0, 2).Value & "!" & " You are logged in."
UF_Encoding.TB_Operator.Text = cel.Offset(0, 2).Value
UF_Encoding.Show
Me.Hide
Else
MsgBox "Invalid Username/Password"
End If
Else
MsgBox "Invalid Username/Password"
End If
End Sub
This code is giving me a Type Mismatched error on the .Find part.
The code is in a Command Button.
Also, this works sometimes and then suddenly will throw up the Mismatched Error.
Please help why it is throwing the error and how to correct it.
I don't want to resort to looping since i have many users.
Avoid the use of ActiveCell, unless there's an absolutely necessary reason to incorporate it.
Please see THIS LINK
Simply change
After:=ActiveCell
to
After:=ws.Range("A2")
One possible solution. I've commented everything, so that you can follow the specific steps.
Sub Hide_Me()
Dim rngHeadings As Range 'the range where your headings are
Dim arrHideColumns() As Variant 'the array, where you list all headings that should be hidden
Dim Item As Variant 'a common variable for the for-each-loop
Dim rngResult As Range 'the range for the search result
'Assign the range, where your headings are
Set rngHeadings = Worksheet1.Range("C3:E3")
'List the headings you want to be hidden
arrHideColumns = Array("Address", "Phone Number")
'Loop through your list
For Each Item In arrHideColumns
'Use the .FIND method of the range-object
'Please read more about this method here: https://learn.microsoft.com/en-us/office/vba/api/excel.range.find
Set rngResult = rngHeadings.Find(Item)
'If there is a result
If Not rngResult Is Nothing Then
'Hide the column
rngResult.EntireColumn.Hidden = False
End If
Next
End Sub