I am looking to build a simple macro to find a date and select all the cells that contain this date (I then have another working macro that modifies the selected cells). However I cant get the find and select to work.
At the moment the code is picking up the first "Jul-18" and then it is spitting out the no match message.
Any help would be much appreciated;
Sub FIND()
On Error GoTo nomatch
Cells.FIND(What:=Jul - 18, LookIn:=xlValues).Select
nomatch:
MsgBox ("Not Found")
End Sub
You should be able to adapt it to your needs easily.
[![enter image description here][1]][1]
Sub FindAndSelectAll()
Dim str As String, c As Range, r As Range
Dim strFind As String
Dim rSearch As Range
Set rSearch = ActiveSheet.Cells
strFind = InputBox("Please enter search string")
With rSearch
Set c = .Find(strFind, LookIn:=xlValues)
If Not c Is Nothing Then
Set r = c
str = c.Address
Do
Set r = Union(r, c)
ActiveSheet.Range(c.Address).Activate
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> str
End If
.Activate
If Not r Is Nothing Then r.Select
End With
End Sub
Related
I have a log that keeps track of what documents my employees have read. When they have read one in person, I manually change the color of the cell in my workbook. Then I have a macro that will look for any cells with the same document name as its value and will match the color. I want to be able to do this with all documents without having to write this macro for every document. I have tried for loops and do loops but I don't fully understand how they work.
Here is a picture of my code, the first sub procedure Match1 works perfectly fine for one document within a worksheet. MatchAll is where I had problems.
I get "Run-time error '1004':
Method 'Range' of object '_Global' failed" a lot or "object variable or with block variable not set"
EDIT:
Public Sub Match1()
Dim c As Range
Dim firstAddress As String
firstAddress = Range("A10").Value
With Range("C1:K500")
Set c = .Find(firstAddress, LookIn:=xlValues)
If Not c.Interior.Color = Range("A10").Interior.Color Then
firstAddress = c.Address
Do
c.Interior.Color = Replace(firstAddress, firstAddress, Range("A10").Interior.Color)
Set c = .FindNext(c)
Loop While Not c.Interior.Color = Range("A10").Interior.Color
End If
End With
End Sub
Public Sub MatchAll()
Dim a As Range
Dim i As Integer
Dim c As Range
Dim firstAddress As String
For i = 8 To 197
a = Range(1, i)
firstAddress = a.Value
With Range("C1:K500")
Set c = .Find(firstAddress, LookIn:=xlValues)
If Not c.Interior.Color = a.Interior.Color Then
firstAddress = c.Address
Do
c.Interior.Color = Replace(firstAddress, firstAddress, a.Interior.Color)
Set c = .FindNext(c)
Loop While Not c.Interior.Color = a.Interior.Color
End If
End With
Next i
End Sub
I tried to replicate the code for finding all the values in a specific range and writing "here" in a cell next to them, but I have a problem with exiting the loop, it always misses one occurrence.
Can anyone explain the solution to me please?
Sub TestValue()
Dim c As Range
Dim firstAddress As String
With shGCD.Range("U:U")
Set c = .Find("THIS", lookat:=xlWhole)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.Offset(, 1).Value = "Here"
Set c = .FindNext(c)
Loop While firstAddress <> .FindNext(c).Address
End If
End With
End Sub
Change this:
Loop While firstAddress <> .FindNext(c).Address
to this:
Loop While firstAddress <> c.Address
You have already updated c, so you should look at the address of the current c and not its successor.
Recoded for clarity and catching error if no initial find.
Sub TestValue()
Dim c As Range
Dim firstAddress As String
With ActiveSheet.Range("U:U")
Set c = .Find("THIS", lookat:=xlWhole)
If Not c Is Nothing Then
firstAddress = c.Address()
Else
GoTo ExitNoMatch
End If
Do While Not c Is Nothing
c.Offset(, 1).Value = "Here"
Set c = .FindNext(c)
If c.Address = firstAddress Then Set c = Nothing
Loop
End With
ExitNoMatch:
End Sub 'TestValue
HTH
I need to find cells with a value of "b" in range A1:A14. There are three such values in that range.
If a value is found, then set B2 to "yes", and then offset one row below.
In this code I wrote the findNext function doesn't work.
Sub sinep()
Dim sinepRng As Range
Dim rangeRover As Range
Set rangeRover = Range("B2")
Set sinepRng = Range("A1:A14").Find("b", LookIn:=xlValues)
If Not sinepRng Is Nothing Then
firstAddress = sinepRng.Address
MsgBox "first address " & firstAddress
Do
rangeRover.Value = "yes"
Set rangeRover = rangeRover.Offset(1, 0)
Set sinepRng = Range("A1:A14").Find("b").FindNext(sinepRng)
MsgBox "third address " & sinepRng.Address
If sinepRng Is Nothing Then
MsgBox "isnothing"
GoTo DoneFinding
End If
Loop While sinepRng.Address <> firstAddress
End If
DoneFinding:
This code does work.
Sub nag()
Dim rangeRover As Range
Set rangeRover = Range("B2")
With Worksheets(1).Range("a1:a500")
Set c = .Find("b", LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
rangeRover.Value = "yes"
Set rangeRover = rangeRover.Offset(1, 0)
Set c = .FindNext(c)
If c Is Nothing Then
GoTo DoneFinding
End If
Loop While c.Address <> firstAddress
End If
DoneFinding:
End With
End Sub
I figure the problem lies within the findNext. I tried modifying it without success. I also tried using Find with After parameter.
Thanks #Rory for the solution.
I had to remove .find("b") from the line Set sinepRng = Range("A1:A14").Find("b").FindNext(sinepRng).
I am new to Vba(and coding in general) and have written a very basic macro to find out "wood" inside a particular column from a larger set of data, however when I try to run it, it's still searching from the whole data set instead of the specified column.
I started with keeping the range of Cel to the whole data set, and then just narrowed it to the third column. However, when I remove the find element the immediate window shows me the address of cells in the third column, just as I want, but as soon as I use Find, it searches through the whole dataset.
I've tried defining propertied in Find object such as After and SearchOrder, but then it shows an error.
Dim emptyrow As Long
emptyrow = WorksheetFunction.CountA(Range("A:A")) + 1
Dim Cel As Range
Dim n As Integer
Set Cel = Range("C2:C54")
For n = 2 To emptyrow
Debug.Print (Cel.Cells(n,3).Find("wood","C2",,,xlByColumn).Address)
Next n
On using properties of Find, I get a type mismatch error.
It's not clear what exactly you want to do with the results, but here are a couple of possible outputs.
Sub xx()
Dim rFind As Range, s As String, v() As Variant, i As Long
With Range("C2:C54")
Set rFind = .Find(What:="Wood", After:=.Cells(.Cells.Count), _
Lookat:=xlWhole, MatchCase:=False, SearchFormat:=False)
If Not rFind Is Nothing Then
s = rFind.Address
Do
Debug.Print rFind.Offset(, -2).Value 'column A value in immediate window
i = i + 1
ReDim Preserve v(1 To i)
v(i) = rFind.Offset(, -2).Value 'or store values in an array
Set rFind = .FindNext(rFind)
Loop While rFind.Address <> s
End If
End With
MsgBox Join(v, ", ")
End Sub
Use this:
Sub fnd_all_wood()
Dim c As Range
Dim firstaddress As String
With Range("C2:C54")
Set c = .Find("wood", LookIn:=xlValues)
If Not c Is Nothing Then
firstaddress = c.Address
Do
Debug.Print c.Address
Set c = .FindNext(c)
If c Is Nothing Then
GoTo DoneFinding
End If
Loop While c.Address <> firstaddress
End If
DoneFinding:
MsgBox "Done All"
End With
End Sub
This will print all the Cell Address in Range C2:C54 where it finds Wood
More information about the Formula Range.FindNext in the Link.
Update:
You can change the line Debug.Print c.Address to any other code where you can get the row by c.row and use it to get the other values like cells(c.row,1) to get the value from Ist column.
Demo:
I have a Range("B6:T10000")
Data in the range are a mixture of blanks,#'s ,numbers (formatted as texts), texts and most importantly formulas.
Can someone please help with a VBA macro to:
Find anything that looks like number and convert it to number
Ignore the rest
Don't convert formulas to values
Thank you very much
You can do this without code, or with quicker code avoiding loops
Manual
Copy a blank cell
Select your range B6:T100001
Press F5. Then Goto ... Special
check Constants and then Text
Paste Special Multiply and check Add
This converts text only cells with numbers into numbers, and leaves actual text or formulae alone
Code
Sub Update()
Dim rng1 As Range
On Error Resume Next
Set rng1 = Range("B6:T10000").SpecialCells(xlCellTypeConstants, 2)
On Error Resume Next
If rng1 Is Nothing Then Exit Sub
'presumes last cell in sheet is blank
Cells(Rows.Count, Columns.Count).Copy
rng1.PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd
End Sub
here's my version:
Sub Test()
Dim rng as Range, cel as Range
Set rng = Thisworkbook.Sheets("Sheet1").Range("B6:T10000")
For Each cel In rng
If Not IsError(cel.Value) Then _
If Len(cel.Value) <> 0 And cel.HasFormula = False And _
IsNumeric(cel.Value) Then cel.Value = Val(cel.Value)
Next cel
End Sub
I've tested it, and works fine.
Hope this helps.
Give this a try:
Sub Converter()
Dim rBig As Range, r As Range, v As Variant
Set rBig = Range("B6:T10000")
For Each r In rBig
v = r.Value
If v <> "" And r.HasFormula = False Then
If IsNumeric(v) Then
r.Clear
r.Value = v
End If
End If
Next r
End Sub
EDIT#1:
This version ignores errors:
Sub Converter()
Dim rBig As Range, r As Range, v As Variant
Set rBig = Range("B6:T10000")
For Each r In rBig
v = r.Value
If Not IsError(v) Then
If v <> "" And r.HasFormula = False Then
If IsNumeric(v) Then
r.Clear
r.Value = v
End If
End If
End If
Next r
End Sub
ActiveSheet.Range("b5:b6004,h5:h6004").Select
For Each xCell In Selection
If IsNumeric(xCell) = False Then
xCell.Value = Val(xCell.Value)
Else
End If
Next xCell