actually the answer for this question is already here.
Get the reference of a cell containing a certain text
which can be done without using macros,
But the problem I have is that I want to search for a certain text with a wild card.
example: DOM???text
You can replace the InStr() function for the Like Operator. Code would look like:
Public Function WhereIs(rIn As Range, sIn As String) As String
WhereIs = ""
Dim r As Range
For Each r In rIn
If r.Text Like sIn Then
WhereIs = r.Address(0, 0)
Exit Function
End If
Next r
End Function
You have to make sure that your sIn string has the correct wildcards.
Try this. Just run it and search for the word in the dialog box. Then it will give you the cell reference.
Option Explicit
Private Sub FindText()
Dim ws As Worksheet
Dim FindString As Variant
Dim rng As Range
Set ws = ThisWorkbook.Worksheets("Sheet1")
FindString = InputBox("Search for value")
If Trim(FindString) <> "" Then
Set rng = ws.Cells.Find( _
What:=FindString, _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
If Not rng Is Nothing Then
MsgBox rng.Address
Else
MsgBox "Nothing found"
End If
End If
End Sub
Related
I have the following code I use to go through a sheet and parse the information onto separate sheets based on the string [Start].
Private Sub CommandButton7_Click()
Application.ScreenUpdating = False
Dim i As Long, rFind As Range, rFind1 As Range, rFind2 As Range, rFind3 As Range, rFind4 As Range, ws As Worksheet, s As String, s1 As String, s2 As String
s = "[Start]"
With Sheets("Full History File").Columns(1)
Set rFind3 = .Find(What:="[HistoryEnd]", LookAt:=xlPart, MatchCase:=False, SearchFormat:=False)
Set rFind = .Cells(Rows.Count, 1)
For i = 1 To WorksheetFunction.CountIf(.Cells, "*" & s & "*")
Set rFind = .Find(What:=s, After:=rFind, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Not rFind Is Nothing Then
Set rFind1 = .Find(What:=s, After:=rFind)
Set ws = Worksheets.Add(After:=Sheets(Sheets.Count))
ws.Name = "Blasted " & i
If i = WorksheetFunction.CountIf(.Cells, "*" & s & "*") Then
Set rFind1 = rFind2.Offset(1)
End If
Range(rFind, rFind1.Offset(-1)).Copy ws.Range("A1")
End If
Next i
End With
Sheets("Blast Summary Sheet").Select
SheetNames
CommandButton6.Visible = True
Application.ScreenUpdating = True
End Sub
My problem is that the information I am working through has changed and I need to adapt the code to do the following:
Search for the string [TrainingModeChanged]
If not found search for the string [TrainingMode]
If not found search for the string [Start]
Once any of the strings are found create the new sheet Blasted with the number and copy the information between the found string up until the next found string which could be either one of the 3 above.
All help in modify the code to do this would be helpfull thanks
I am not entirely sure what you are after, but you could write a function that returns your required string instead of hardcoding it. Function below:
Option Explicit
Function getString() As String
'we will use On Error Resume Next to by pass the expected error if cannot find the string
On Error Resume Next
Dim searchRng As Range
Dim mySheet As Worksheet
Set mySheet = ThisWorkbook.Sheets("Full History File")
'search for first range
Set searchRng = mySheet.Columns(1).Find(What:="[TrainingModeChanged]", LookIn:=xlValues, LookAt:=xlWhole)
If Not searchRng Is Nothing Then
'this means search range was found
getString = searchRng.Value
'reset error handling
On Error GoTo 0
Exit Function
End If
'implicit to say if program runs here first search was unsuccessful
Set searchRng = mySheet.Columns(1).Find(What:="[TrainingMode]", LookIn:=xlValues, LookAt:=xlWhole)
If Not searchRng Is Nothing Then
'this means search range was found
getString = searchRng.Value
On Error GoTo 0
Exit Function
End If
'implicit to say if program runs here second search was unsuccessful
Set searchRng = mySheet.Columns(1).Find(What:="[Start]", LookIn:=xlValues, LookAt:=xlWhole)
If Not searchRng Is Nothing Then
'this means search range was found
getString = searchRng.Value
On Error GoTo 0
Exit Function
End If
End Function
And you call in your routine as:
s = getString()
And then continue on with your code..
I created a variable oldPassword which is populated using a VLookup.
I am trying to get now the cell address from that result but nothing seem to work.
Dim oldPassword As String
oldPassword = Application.WorksheetFunction.VLookup(Me.ComboBox1.Value, Worksheets("Employees").Range("A:B"), 2, False)
You should break the task into steps
Get a reference to the cell containing the search value
Use that reference to get the required value and address
Sub Demo
Din rSearch As Range
Dim rUser as Range
Dim rPassword As Range
Dim idx As Variant
Set rSearch = Worksheets("Employees").Range("A:B")
idx = Application.Match(Me.ComboBox1.Value, rSearch.Columns(1), 0)
If Not IsError(idx) Then
Set rUser = rSearch.Cells(idx, 1)
Set rPassword = rUser.Cells(1, 2)
' get the result
oldPassword = rPassword.Value2
' get the address
Debug.Print rPassword.Address
End If
End Sub
I would prefer using .Find as #Andreas suggested but then that is my personal preference.
Option Explicit
Sub Sample()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Employees")
Dim aCell As Range
Set aCell = ws.Columns(1).Find(What:=ComboBox1.Value, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
Dim oldPassword As String
If Not aCell Is Nothing Then
With aCell.Offset(, 1)
'~~> Do what you want with that cell
oldPassword = .Value2
MsgBox .Address
End With
Else '<~~ Optional
MsgBox ComboBox1.Value & " not found!"
End If
End Sub
I'm using vba method Replace, and I need to change every "/" to ",". This looks like a simple task so I use:
ActiveWorkbook.Worksheets(2).Cells.Replace What:="_/_", Replacement:=",", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=True, _
ReplaceFormat:=True
The problem is when one of cells has value like:
04_/_2018
And the result is:
4,2018
instead of:
04,2018
All of my cells in this workbook has text formating before and after aplying the code. My guess is that Excel in a process is changing the format to general for a moment and it cut offs not necessary for a number left zero.
I've tried to bypass this issue by changing parameters of the method (none of this worked) and changing the decimal separator from "," to ".". This helped when using find and replace by hand from Excel, but when I record it and try to use as Macro it doesn't work. What can I do to prevent Excel from cutting off zeros in this scenarios?
If you want 04,2018 then use .Find/.FindNext then replace+reconstruct the value before placing in the cell.
Is this what you are trying?
Sub Sample()
Dim oRange As Range, aCell As Range, bCell As Range
Dim ws As Worksheet
Dim ExitLoop As Boolean
Dim SearchString As String
On Error GoTo Whoa
Set ws = Worksheets("Sheet1")
Set oRange = ws.UsedRange
SearchString = "_/_"
Set aCell = oRange.Find(What:=SearchString, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not aCell Is Nothing Then
Set bCell = aCell
If Left(aCell.Value, 1) = 0 Then
aCell.Value = "'" & Replace(aCell.Value, SearchString, ",")
Else
aCell.Value = Replace(aCell.Value, SearchString, ",")
End If
Do While ExitLoop = False
Set aCell = oRange.FindNext(After:=aCell)
If Not aCell Is Nothing Then
If aCell.Address = bCell.Address Then Exit Do
If Left(aCell.Value, 1) = 0 Then
aCell.Value = "'" & Replace(aCell.Value, SearchString, ",")
Else
aCell.Value = Replace(aCell.Value, SearchString, ",")
End If
Else
ExitLoop = True
End If
Loop
Else
MsgBox SearchString & " not Found"
End If
Exit Sub
Whoa:
MsgBox Err.Description
End Sub
Screenshot
The leading zeroes are automatically removed in Excel by default. Thus 04,2014 is changed to 4,2014. A way to work around this is to format the cells as Text, adding this line before the Replace():
ActiveWorkbook.Worksheets(2).Cells.NumberFormat = "#"
Formatting to Text has a lot of unpleasant changes, e.g. the text goes to the left and Excel does not recognize the dates/numbers by default.
This is a simple sample of the code, changing 1 cell:
Sub TestMe()
ActiveWorkbook.Worksheets(1).Cells.NumberFormat = "General"
Range("B5") = "05_2018"
ActiveWorkbook.Worksheets(1).Cells.NumberFormat = "#"
Range("B5") = Replace(Range("B5"), "_", ".")
End Sub
Formatting to text can work like this, for bigger, unknown ranges:
Sub TestMe()
Worksheets(1).Cells.NumberFormat = "General"
Range("A1:B15") = "05_2018"
Dim findRange As Range
Set findRange = Worksheets(1).Cells.Find("_")
Dim myCell As Range
If Not findRange Is Nothing Then
For Each myCell In findRange
myCell.Replace "_", ","
Next myCell
End If
End Sub
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 trying to search a column that has duplicate entries of information. I want to select the last found occurence of the string in the column. How can I do this?
If possible, please show me how this can be done with the Selection.Find method.
Columns("A:A").Select
Selection.Find(What:="foobar", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Sub FindAndSelectAll()
Dim str As String, cll As Range, c As Range
Dim rSearch As Range
Set rSearch = Range("A1").CurrentRegion
With rSearch
For Each cll In rSearch
Set c = .Find(cll.Value2, _
LookIn:=xlValues, _
searchdirection:=xlPrevious)
If Not c Is Nothing And cll.Row < c.Row Then
Range(c.Address).Interior.Color = 65535
End If
Next
End With
End Sub
I found the answer I was looking for. By setting the SearchDirection property to xlPrevious, it will find the last value in the range. Then the cell can be focused on by using the .Select method. However, if the value that is being searched is a substring of other values within the column, it may select the wrong cell. This is solved by using a while loop that checks the value of the cell it finds, and keeps searching the previous value if it is not the string we are looking for.
Sub FindLast()
Dim fc As Range
Dim my_var As String
Dim cell_check As Variant
my_var = "String 1"
Set fc = Worksheets("Sheet1").Columns("A").Find(what:=my_var, _
SearchDirection:=xlPrevious)
fc.Select
cell_check = ActiveCell.Value
While cell_check <> my_var
Set fc = Worksheets("Sheet1").Columns("A").FindPrevious(after:=fc)
fc.Select
cell_check = ActiveCell.Value
Wend
End Sub
I found the solution by reading the documentation on Microsofts website.
https://learn.microsoft.com/en-us/office/vba/api/excel.range.findprevious