I have 2 workbooks. I need copy the row in one workbook only if it contains a certain value from another workbook. Here's my code, it works for the first i=21 and i=22 but tells me there's an error in Cells.Find when I reach i=23.
For i = 21 To 35
Windows("Run Report.xlsm").Activate
Dim strL3 As String
strL3 = Sheets("Summary").Range("A" & i).Value
Workbooks("Ace Survey - Level 1 and level 3 Trending (w Resolution) v3").Activate
Range("A1").Activate
Cells.Find(What:=strL3, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
If strL3 = "Call Disconnected" Or strL3 = "Caller Not Present" Then
ActiveCell.Offset(2, 2).Select
Else
ActiveCell.Offset(1, 2).Select
End If
Application.CutCopyMode = False
ActiveCell.Copy
Windows("Run Report.xlsm").Activate
Sheets("Summary").Select
Range("G" & i).Select
ActiveSheet.Paste
Next i
Find returns a Range object if something is found, but Nothing otherwise. You are attempting to Activate the result of using Find, even if it is Nothing - which will generate an error.
You need to store the result of your Find attempt in a Range variable, and check for Nothing.
Dim rngFound As Range
Set rngFound = Range("A1").Find(...)
If Not rngFound Is Nothing Then
' we found something!
Else
' Nothing
End If
But, as advised, you should be supplying more details for your question.
Related
I am currently trying to find a certain word within an excel spreadsheet, copy the cell on the right and then paste it a further 3 cells to the right and 3 cells down, before dragging this down.
I have compiled the following which does the job.
Cells.Find(What:="N/C:", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
Selection.Offset(0, 1).Select
Selection.Copy
Selection.Offset(3, 3).Select
ActiveSheet.Paste
Range(Selection, Selection.End(xlDown)).Select
Selection.FillDown
My question is:
How can I extend this code so it searches for all "N/C:" and does the above
Feel free to provide updates to my initial code if it can be improved
Lightly tested:
Sub Tester()
Dim col As Collection, c, sht As Worksheet
Set sht = ActiveSheet
Set col = FindAll(sht.UsedRange, "N/C:")
Debug.Print "Found " & col.Count & " matches"
For Each c In col
c.Copy c.Offset(3, 3)
sht.Range(c.Offset(3, 3), c.Offset(3, 3).End(xlDown)).FillDown
Next c
End Sub
Public Function FindAll(rng As Range, val As String) As Collection
Dim rv As New Collection, f As Range
Dim addr As String
Set f = rng.Find(what:=val, after:=rng.Cells(rng.Cells.Count), _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
If Not f Is Nothing Then addr = f.Address()
Do Until f Is Nothing
rv.Add f
Set f = rng.FindNext(after:=f)
If f.Address() = addr Then Exit Do
Loop
Set FindAll = rv
End Function
The short answer is that there is no built-in way to return a range with all the find results (i.e. find all) in one go. You have to find the first result (the code you already have) and then use findNext within a while loop, exiting only when the next result until it refers to the same cell as the first result.
There is a good explanation/implementation at http://www.cpearson.com/excel/findall.aspx
New to forum and vba but want to learn more.
Got two tables of large data and want to look for a cell value equal to the cell value to the left of my active cell in table 1 and then find that value in the 2nd table. When value is found I want to return the cell value found in the 5th column to the right of column A in the 2nd table.
The macro I have created works well - if it hadn't been that it always looks for the same value "10.136.32.10" i.e. this value does not change as the active cell moves down table 1. I would like the value to change depending on what is actually copied from the cell to the left. Is there a way to do this? I use Ctrl+f function and then paste in the cell value copied from table 1
Have the following macro:
Sub Makro2()
'
' Makro2 Makro
'
'
ActiveCell.Offset(0, -1).Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("SKF-NOV-6-2017").Select
Cells.Find(What:="10.136.32.10", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Selection.End(xlToLeft).Select
ActiveCell.Offset(0, 4).Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("All Equipment").Select
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Range("A1").Select
End Sub
Here is the code by which you can do your job. This macro searches immediately on all rows. If you only need to search for an active cell, then you need to remove the loop.
Sub macro2()
Dim lr As Long, r As Long, c As Long
Dim str As String
lr = Cells(Rows.Count, 1).End(xlUp).Row
For r = 1 To lr
str = Cells(r, c).Offset(0, -1)
Sheets("SKF-NOV-6-2017").Select
Cells.Find(What:=str, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Selection.End(xlToLeft).Select
ActiveCell.Offset(0, 4).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("All Equipment").Select
Cells(r, c + 1).past
Next r
End Sub
I've trawled through a few hours of Google looking for an answer for this, so I apologise if it seems obvious to you, it really isn't to me!
I'm trying to take a cell value from 1 workbook, search for it in another. As a result of that, select some data in the search result's row, copy and paste into a cell in the search term's row in the original workbook.
Here's what I've written:
Sub AutoCableSize()
'
' AutoCableSize Macro
Dim Row As Integer
Dim CableRef As String
Dim Rng As Integer
Rng = 0
Row = 1
CableRef = ""
Windows("170615-Submains Cable Schedule.xlsx").Activate
For Each Cell In Range("F3:F303"):
On Error Resume Next
If CableRef = "Finish" Then
GoTo Finish:
End If
CableRef = Range("F" & Row).Value
Windows("170601-B2-3-HL_BAS_SCH_61_0001.xlsx").Activate
Columns("A:A").Select
Selection.Find(What:=CableRef, LookIn:=xlValues _
, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Select
Rng = ActiveCell.Row
If Rng = 1 Then
GoTo Continue
End If
Range("C" & Rng, "D" & Rng).Copy
Windows("170615-Submains Cable Schedule.xlsx").Activate
Range("J" & Row).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Continue:
Row = Row + 1
Next Cell
Finish:
End Sub
What should I put in the Find variables to search for an exact result. I have used xlWhole but I am having an issue:
If the entry does not exist, it skips to the next correctly.
If the entry does exist, it selects the first blank cell in the search series, and treats that as the search result?! I have no idea why!
Try this instead:
Option Explicit
Sub AutoCableSize()
Dim r As Range, findRng As Range
Dim ws1 As Worksheet, ws2 As Worksheet
Set ws1 = Workbooks("170615-Submains Cable Schedule").Worksheets("Sheet1")
Set ws2 = Workbooks("170601-B2-3-HL_BAS_SCH_61_0001").Worksheets("Sheet1")
For Each r In ws1.Range("F3:F303")
Set findRng = ws2.Columns("A:A").Find(What:=r.Value, LookIn:=xlFormulas _
, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not findRng Is Nothing Then
findRng.Copy
ws1.Range("J" & r.Row).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
Next r
End Sub
I've changed your code a lot. The main thing to notice is that I haven't used Activate or Select anywhere. Referring directly to the workbook/worksheet/cell rather than activating it and working with selection is a much better style and it's the first thing to learn if you want to write error-free code.
More here: How to avoid using Select in Excel VBA macros
#CallumDA
In looking at your answer code, I found that in recent Excel versions, it DID NOT FUNCTION correctly - UNLESS you used exactly what the Macro recorder creates:
Set X = {AnyRangeVariableHere}.Find(...) method calls fail universally to return an object instance now, leaving X = Nothing (and failing to find a target, even when a valid one exists).
The only syntax which seems to work is literally:
Set X = Cells.Find(...)
If you look it all up the documents, this distinction makes no sense, but I can assure you that with Excel 2016/2019, this certainly seems to be the case.
Apparently Application.Cells method is some sort of special case/subclass whereby the .Find method actually still functions and returns a range object reference.
I´m writing a simple macro for searching my value in table. I know that searched value is in the document many times. But my macro finds just first value in table. I want select all rows with the value I´m looking for. Then I want copy selected rows and copy them to "sheet2". Can somebody help me adjust my macro? Thx
Sub Vyhladat()
Sheets("Sheet1").Columns(24).Find(What:=InputBox("Please enter your LR number", "Search")).Select
ActiveCells.EntireRow.Select
Selection.Copy
Sheets("Sheet2").Select
Range("A2").Select
Do
If IsEmpty(ActiveCell.Value) Then
ActiveCell.PasteSpecial xlPasteValues
End
Else
ActiveCell.Offset(1, 0).Select
End If
Loop
End Sub
Here is how to do it (find the first match and then loop with the FindNext() method) :
Sub test_Jean()
Dim FirstAddress As String, _
cF As Range, _
RowsToCopy As String
ActiveSheet.Cells(1, 24).Activate
With ActiveSheet.Columns(24)
'First, define properly the Find method
Set cF = .Find(What:=InputBox("Please enter your LR number", "Search"), _
After:=ActiveCell, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
'If there is a result, keep looking with FindNext method
If Not cF Is Nothing Then
FirstAddress = cF.Address
Do
cF.EntireRow.Copy
Sheets("Sheet2").Range("A" & Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row + 1).PasteSpecial xlPasteValues
Set cF = .FindNext(cF)
'Look until you find again the first result
Loop While Not cF Is Nothing And cF.Address <> FirstAddress
End If
End With
End Sub
I have this question and answered code at On excel how to search & replace a string on a column using a library. Which I am having three (3) problems.
RUN-TIME ERROR 13, HOW TO DETERMINE IF findRange HAS FOUND SOMETHING?
IS THIS THE CORRECT WAY TO FIND THE findRange?
HOW TO ADD A "NOT FOUND" ON THE ACTIVE SHEET PAGE?
FROM:
TO: -- This is what I wish to accomplish.
The vba code can be seen below:
Sub FindAndReplace()
' FindAndReplace Macro
' #author Louie Miranda
' Ability to find the range of ids against another worksheet
' and insert the name on the main sheet, one issue is if the value does not exist
Dim findRange as Object
' Loop over the current worksheet
For Each c In Worksheets("RECORDS").Range("A3:A7").Cells
' Go to Agents sheet
Sheets("AGENTS").Select
' Do a search
Columns("B:B").Select
' Q1: RUN-TIME ERROR 13, HOW TO DETERMINE IF findRange HAS FOUND SOMETHING?
Set findRange = Cells.Find(What:=c, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
' Determine if the find has something
' Q2: IS THIS THE CORRECT WAY TO FIND THE findRange?
If findRange Is Nothing Then
MsgBox "not found"
' Back to records sheet
Sheets("RECORDS").Select
'Range(c.Address).Offset(0, 1).Select
'ActiveSheet.Paste
' Q3: HOW TO ADD A "NOT FOUND" ON THE ACTIVE SHEET PAGE?
Else
Application.CutCopyMode = False
' Choose beside the column to copy
ActiveCell.Offset(rowOffSet:=0, columnOffset:=-1).Activate
Selection.Copy
' Back to records sheet
Sheets("RECORDS").Select
' Copy the agent name to RECORDS sheet
Range(c.Address).Offset(0, 1).Select
ActiveSheet.Paste
End If
Next c
End Sub
Any help is much appreciated.
Kind regards
I have updated your code. This should work now.
Sub FindAndReplace()
Dim findRange As Range
Dim c As Range
' Loop over the "RECORDS" worksheet
For Each c In Worksheets("RECORDS").Range("A3:A7").Cells
'Set findRange in "AGENTS" sheet
With Worksheets("AGENTS")
Set findRange = .Cells.Find(What:=c.Value, After:=.Cells(1, 1), LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)
End With
If Not findRange Is Nothing Then
'if found then
Sheets("RECORDS").Cells(c.Row, c.Column + 1) = Sheets("AGENTS").Cells(findRange.Row, findRange.Column - 1).Value
Else
'if not found then
Sheets("RECORDS").Cells(c.Row, c.Column + 1) = "Not Found"
End If
Next c