Excel VBA Highlight search - vba

I'm trying to use a word in one cell, and then go to another sheet and find that word in another cell. The tricky part is that the second sheet has this word in many places, and I only want the cell that has the word highlighted in blue.
I've tried the following, but the loop keeps on passing over the blue highlighted word and continuing. What am I doing wrong?
Sub TryingIt()
Dim r As Excel.Range
Dim strName As String
Dim strFirstFound As String
strName = ActiveCell.Text
Sheets("Waiting For").Select
Range("A1").Select
Cells.Find(What:=strName, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Set r = ActiveCell
If r.Interior.color = vbBlue Then
r.Offset(1, 0).Select
Else:
Do
Cells.Find(What:=strName, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Set r = ActiveCell
Loop While r.Interior.color <> vbBlue
r.Offset(1, 0).Select
End If
End Sub

Here's the answer:
You have to be careful to be more specific about the color. In my case, it was RGB(0,176,240), not just vbBlue.

Related

vba Entire Column should copy

" find " cell value in header will keep changing in raw file, i need " find " cell value ENTIRE column should copy and paste in sheet2
Sub Macro3()
Cells.Find(What:="FSP Center", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate`
Cells.FindNext(After:=ActiveCell).Activate`
Columns("A:A").Select 'i want to select entire column
Selection.Copy
Sheets("Sheet2").Select
ActiveSheet.Paste
End Sub
Sub Macro3()
Dim f As Range
Set f = Rows(1).Find(What:="FSP Center", After:=ActiveCell, _
LookIn:=xlFormulas, LookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext)
If Not f Is Nothing Then
f.EntireColumn.Copy Sheets("Sheet2").Range("A1")
End If
End Sub
'fixed the misspelling "If"

Find all matched cell value in a range

I created a macro which finds all matched values of a cell in a range. The user enter for example numb in the cell A2 Then every time he clicks on Find button it will show him the matched cell for example Order Number then purchase number then part number ...
Here is my code
Sub find_matched_cells()
w = ActiveWorkbook.Sheets("Sheet4").Range("A2")
ActiveWorkbook.Sheets("Sheet4").Range("A4:A104").Find(What:=(w), After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Activate
End Sub
It works fine but when the user for example press on a cell not in my range then on the button find will not work. The issue is in
After:=ActiveCell
For example if by mistake you selected a cell in a range not in A4:A104 then the ActiveCell will not be in my range and it will give an error.
I need to add condition for example the first ActiveCell Starts from A4 and if I find the first matched cell then ActiveCell will take that value.
Any other suggestions please? Thank you very much.
One approach is this...
Sub find_matched_cells()
Dim Rng As Range
Set Rng = ActiveWorkbook.Sheets("Sheet4").Range("A4:A104")
w = ActiveWorkbook.Sheets("Sheet4").Range("A2")
If Intersect(ActiveCell, Rng) Is Nothing Then Range("A4").Select
Rng.Find(What:=(w), After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Activate
End Sub
You could check the intersection. I would re-write the code slightly depending on what you need to actually do to each of these found cells - is it just select them? I have amended code below to avoid error if the value is not found.
Sub x()
Dim rFind As Range, sAddr As String, w
w = ActiveWorkbook.Sheets("Sheet4").Range("A2")
With ActiveWorkbook.Sheets("Sheet4").Range("A4:A104")
Set rFind = .Find(What:=w, LookIn:=xlFormulas, LookAt:=xlPart, MatchCase:=False, SearchFormat:=False)
If Not rFind Is Nothing Then
sAddr = rFind.Address
Do
rFind.Select
MsgBox w & " found at " & rFind.Address
Set rFind = .FindNext(rFind)
Loop While rFind.Address <> sAddr
End If
End With
End Sub

Find a range in another Sheet

I have the piece of code below:
Selection.Find(What:="4", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
Dim cl As Range, rTest As Range
Set rTest = Range("a1", Range("a1").End(xlToRight))
For Each cl In rTest
If Not cl.Value > 0 Then
cl.EntireColumn.Hidden = True
End If
Next cl
End Sub
Where says What=4, i would like to search the Range(e15) of another worksheet. Search the value of E15 in one sheet and look for it in a specific range in another sheet. I have all the other piece set, but I dont know how I can reference the value of e15, this can 4 or any other number. After finding, hide all columns that are not my specific value. Many thanks!
you should act like follows
Dim f As Range
Set f = Selection.Find(What:=Worksheets("otherWorksheetName").Range("e15").Value, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)
If Not f Is Nothing Then
f.Activate '<--| what do you need this for?
Range("A1", Range("A1").End(xlToRight)).EntireColumn.Hidden = True '<--| hide all columns in wanted range
f.EntireColumn.Hidden = True '<--| unhide found range column
End If
where you have to change "otherWorksheetName" to you actual "other " worksheet name

VBA - how to go about the automation of checking the inputs (newbie here)

Specifically what I would want to do is find a way to check if a certain input in Sheet1 cell, is also found in sheet2.
Not knowledgeable with VBA so I tried recording macro
Sheets("Sheet2").Select
Cells.Find(What:="asd", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
Now instead of string "asd", I want the input in sheet1, below
Sheets("Sheet1").Select
Range("B1").Select
I tried changing "asd" to input in sheet1,
Sheets("Sheet2").Select
Cells.Find(What:=
Sheets("Sheet1").Select
Range("B1").Select, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
but it's giving me an error. Any one can please help how to go about this or recommend a different approach to resolve my problem.
If you want to compare strings in different sheets, just create a new button and add fallowing code:
If Sheets("sheet1").Range("b1") = Sheets("sheet2").Range("b1") then
msgbox " string match"
Else
msgbox " string don't match"
End If
This code will compare cell b1 from sheet1 to cell b1 from sheet2
Try this:
Cells.Find(What:=ThisWorkbook.Sheets("Sheet1").Range("B1").Value, _
LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True, SearchFormat:=False).Select
EDIT: As I told you in the comment
Dim MyCell as Range
Set MyCell = ThisWorkbook.Sheets("Sheet2").Cells.Find(What:=ThisWorkbook.Sheets("Sheet1").Range("B1").Value, _
LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True, SearchFormat:=False)
'This will check if it is found or not
If MyCell Is Nothing Then
MsgBox "Did not find it"
Else
MsgBox "Found it"
End If
Use the Instr function
Dim pos As Integer
pos = InStr(Sheets("sheet2").Range("b1"), Sheets("sheet1").Range("b1"))
If pos<> 0 then
msgbox " string match"
Else
msgbox " string don't match"
End If

find a cell with specific text, multiple occurences, and past active cell in all cells containing specific text

I am currently working on a report, originating in Infoview (SAP business Objects)
This is a report that provides valuable information on a weekly basis, to enhance awareness of current shop performance.
Like the tile of the post might show i want to find a cell with specific text. It has multiple occurrences, and I want to past a previously selected cell in all of those instances.
I can reach the same result by Ctrl-F, "Search all" ( for the "specific text") and than Paste (the previously selected cell)
( http://www.extendoffice.com/documents/excel/816-excel-select-cells-with-specific-text.html)
But i would like to automate this.
I want to use:
Cells.Find(What:="[ö]", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
and
Cells.FindNext(After:=ActiveCell).Activate
But I can't incorporate the two in one macro that gives me the result i describes above.
The previously selected cell contains a formula, containing index(match) and a reference to a cell on the same row as the "specific text".
In my opinion this way of doing stuff saves me a lot of trouble with dynamic cell references ect.
I hope you can help
Your request is a little vague, but I believe this will get you started
Dim PasteValue as string 'this is what you're pasting in
Dim WS as Worksheet
Dim FirstCell as string
Dim rng as range
PasteValue = 'do something here to get your value
set rng = Cells.Find(What:="[ö]", LookIn:=xlFormulas, LookAt:= xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, _
SearchFormat:=False)
while not rng is nothing 'make sure you found something
if len(FirstCell) = 0 then
firstcell = rng.address 'save this spot off so we don't keep looping
end if
rng.value = PasteValue
'now find the next one
set rng = Cells.Find(What:="[ö]", LookIn:=xlFormulas, LookAt:= xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, _
SearchFormat:=False)
if rng.address = FirstCell then 'back at the first cell
set rng = nothing 'so get out of the loop
endif
end while
Thanks for the code above, it helped a lot.
This is the final code, in case anyone needs it. The
If rng Is Nothing Then Exit Do
Loop While rng.Address <> strFirstAddress
is particulary usefull.
Sub Fill_VCNC()
Dim formula_ö As String
Dim rng As Range
Dim strFirstAddress As String
With Range("S:S")
Set rng = Cells.Find(What:="[ö]", LookIn:=xlValues, LookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, _
SearchFormat:=False)
If Not rng Is Nothing Then
strFirstAddress = rng.Address
Do
rng.formula = formula_ö
.NumberFormat = "0.00"
Set rng = .FindNext(rng)
If rng Is Nothing Then Exit Do
Loop While rng.Address <> strFirstAddress
End If
End With
End Sub
( source : https://social.msdn.microsoft.com/Forums/en-US/958fca4e-b19d-4b50-8235-e05adc7f25d5/loop-through-a-range-until-value-not-found?forum=exceldev)