Vlookup using the cell address as table_array - vba

I am using vba in excel and I want to do a vlookup from two other excels and store it in the current excel. But I am facing some issue.
Could anyone be kind enough to help me out in this?
I have extracted the cell address for "lookup_value" and "table_array" (for the vlookup) from the two excels respectively by using the user input. And then I am implementing the vlookup and want to paste the result in the current excel(this is the point at which I am facing the issue).
Below is the code:
Public Sub CommandButton4_Click()
Dim Dept_Row As Long
Dim Dept_Clm As Long
Dim myFileName11 As String
Dim E_name1 As String
Dim E_name12 As String
Dim aCell1 As Range
Dim aCell12 As Range
Dim myFileName1 As String
Dim mySheetName1 As String
Dim wkb1 As Workbook
Dim sht1 As Worksheet
Set wkb1 = Workbooks.Open("C:\Users\shashank_khanna\Desktop\extract.csv")
wkb1.Sheets("extract").Activate
Set sht1 = wkb1.Sheets("extract")
E_name1 = InputBox("Enter the matching field name in the Extract.csv :")
If Len(E_name1) > 0 Then
Set aCell1 = sht1.Rows(1).Find(What:=E_name1, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
myFileName1 = wkb1.Name
myFileName11 = myFileName1
mySheetName1 = sht1.Name
Else
MsgBox ("You entered an invalid value")
End If
E_name12 = InputBox("Enter the output field name in the Extract.csv :")
If Len(E_name12) > 0 Then
Set aCell12 = sht1.Rows(1).Find(What:=E_name12, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
Else
MsgBox ("You entered an invalid value")
End If
Dim E_name2 As String
Dim E_name22 As String
Dim aCell2 As Range
Dim aCell22 As Range
Dim myFileName2 As String
Dim mySheetName2 As String
Dim wkb2 As Workbook
Dim sht2 As Worksheet
Set wkb2 = Workbooks.Open("C:\Users\shashank_khanna\Desktop\extract2.csv")
wkb2.Sheets("extract2").Activate
Set sht2 = wkb2.Sheets("extract2")
E_name2 = InputBox("Enter the matching field name in the Extract2.csv :")
If Len(E_name2) > 0 Then
Set aCell2 = sht2.Rows(1).Find(What:=E_name2, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
myFileName2 = wkb2.Name
mySheetName2 = sht2.Name
Else
MsgBox ("You entered an invalid value")
End If
E_name22 = InputBox("Enter the output field name in the Extract2.csv :")
If Len(E_name22) > 0 Then
Set aCell22 = sht2.Rows(1).Find(What:=E_name22, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
Else
MsgBox ("You entered an invalid value")
End If
Dim cellAddress As String
Dim cellAddress1 As String
Dim cellAddress2 As String
Dim Table2 As Worksheet
Dim Table1 As Range
Workbooks("extract.csv").Activate
'Set Table1 = wkb1.Sheets("extract").Columns(aCell1.Column).Select
Set Table1 = Worksheets("extract").Range(aCell1.Address).End(xlDown)
Dim CellString1 As Range
Set CellString1 = Range(aCell2.Address)
Dim CellString2 As Range
Set CellString2 = Range(aCell22.Address)
If (aCell2.Column > aCell22.Column) Then
Workbooks("RunVlookup.xlsm").Activate
Worksheets("Sheet1").Select
For Each cl In Table1
**Worksheets("Sheet1").Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Value = _
WorksheetFunction.VLookup("c1",
sht2.Range(Cells(2, aCell22.Column),
Cells(2, aCell2.Column)), 2, False)**
//// I am facing "error 1004 Application defined" on this line.
Next cl
MsgBox "Done"
End If
MyErrorHandler:
If Err.Number = 1004 Then
MsgBox "Employee Not Present in the table."
End If
End Sub
Thank you.
I have two workbooks:
Extract.csv - Sheet name as 'extract' containing two columns ID and Name.
Extract2.csv - Sheet name as 'extract2' containing two columns "ID" and "Name".
I have another excel RunVlookup.xlsm and I need to do the look up from extract and extract2 workbooks and have the result on Sheet1 of RunVlookup.xlsm.
Could you please help me out on how to achieve this and correct me on the lookup range I am selecting.
aCell22 is the cell with column "ID" in Extract2.csv file.
aCell2 is the cell with column "Name" in Extract2.csv file.
aCell1 is the cell with column 'Name" in Extract.csv file.

WorksheetFunction.VLookup("c1", _
sht2.Range(sht2.Cells(2 aCell22.Column), _
sht2.Cells(2, aCell2.Column)), 2, False)
An unqualified Cells() defaults to the activesheet, so your code fails unless sht2 is active.
Your lookup range is only a single row though, so it's not clear what you intend here.

Related

VBA run code after user selects option from dynamic Form Control Combobox

I have an excel workbook where an unknown amount of data from text files can be imported (the user will import as many text files as they feel necessary). I am attaching an identifier (1, 2, 3, etc) each time a text file is imported to the workbook. On the "Information Sheet" I have a form control combobox where the user selects the "initial data set" aka (1, 2, 3, etc) by selecting the identifier value from the dropdown. What I want to happen is when the user selects a value to specify the initial data set, this data set will get highlighted in grey on the "Data Importation Sheet" aka the sheet where all the data gets imported to. I think my code is close but it isnt working.
Here is my code for the Combobox:
Private Sub ComboBox1_Change()
Call Find_Initial_Data_Set
End Sub
And here is my code for highlighting the data in the "Data Importation Sheet" according to the value in cell E12 where my Combobox is located:
Sub Find_Initial_Data_Set()
Dim ws As Worksheet
Dim aCell As Range
Dim aCell1, aCell2, aCell3 As Range
Dim NewRange As Range
Dim A As String
Dim LastRow As Integer
Worksheets("Information Sheet").Activate
If Range("E12").Value <> "" Then
Set ws = Worksheets("Data Importation Sheet")
A = Worksheets("Information Sheet").Range("E12").Value
Worksheets("Data Importation Sheet").Activate
With ws
Set aCell = .Rows(1).Find(What:=A, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
End With
LastRow = Worksheets("Data Importation Sheet").Cells(Rows.Count, "A").End(xlUp).Offset(-1).Row
With ws
Set aCell1 = aCell.Offset(0, -1)
Set aCell2 = aCell.Offset(LastRow, 5)
Debug.Print aCell1.FormulaR1C1
Debug.Print aCell2.FormulaR1C1
Set NewRange = .Range(aCell1.Address & ":" & aCell2.Address)
Debug.Print NewRange.Address
End With
NewRange.Interior.ColorIndex = 15
Else
End If
End Sub
Here are some visuals of my excel book:
Data Importation Sheet where the data gets input (you cannot see the identifier in this pic but beneath the data I have a cell that says Identifier with the corresponding importation value beside it):
Information Sheet where the user selects the initial data set based on identifier:
And this is what I would like the Data Importation Sheet to look like after the user selects 1 (for example) for the initial data set:
Any advice would be greatly appreciated!
the code would be like this.
sheet's code
Private Sub ComboBox1_Change()
Call Find_Initial_Data_Set(ComboBox1.Text)
End Sub
module code
Sub Find_Initial_Data_Set(A As String)
Dim Ws As Worksheet
Dim aCell As Range, NewRange As Range
Dim LastRow As Integer
Set Ws = Worksheets("Data Importation Sheet")
With Ws
If A <> "" Then
Set aCell = .Rows(1).Find(what:=A, after:=.Range("a1"), LookIn:=xlValues, lookat:=xlPart)
If aCell Is Nothing Then
Else
Set aCell = aCell.Offset(, -1)
LastRow = .Range("a" & Rows.Count).End(xlUp).Row
Set NewRange = aCell.Resize(LastRow, 7)
NewRange.Interior.ColorIndex = 15
End If
End If
End With
End Sub
i rewrote your code somewhat
please single-step through code using F8 key
check if correct ranges are "selected" at "debug" lines
please update your post with findings
i suspect that the wrong cells are being referenced once the worksheet is partially populated
also, please refrain from using: ( ... this means, anyone reading this)
With ws
Set aCell = .Rows(1).Find(What:=A, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
End With
use this:
Set aCell = ws.Rows(1).Find(What:=A, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
it is shorter and more readable
use "with" convention only if it really simplifies the code a lot
see the end of the code for info that may help you
Sub Find_Initial_Data_Set()
Dim infoSht As Worksheet
Dim dataImpSht As Worksheet
Dim aCell As Range
' Dim aCell1, aCell2 As Range ' do not use ... aCell1 is declared as variant. not as range
Dim aCell1 As Range, aCell2 As Range, aCell3 As Range
Dim NewRange As Range
Dim A As String
Dim LastRow As Integer
Set dataImpSht = Worksheets("Data Importation Sheet")
Set infoSht = Worksheets("Information Sheet")
A = infoSht.Range("E12").Value
If A <> "" Then
Set aCell = dataImpSht.Rows(1).Find(What:=A, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
dataImpSht.Activate ' debug .Select command fails if sheet is not visible
aCell.Select ' debug (this should highlight "aCell")
dataImpSht.Cells(dataImpSht.Rows.Count, "A").Select ' debug
dataImpSht.Cells(dataImpSht.Rows.Count, "A").End(xlUp).Select ' debug
dataImpSht.Cells(dataImpSht.Rows.Count, "A").End(xlUp).Offset(-1).Select ' debug
dataImpSht.Cells(dataImpSht.Rows.Count, "A").End(xlUp).Offset(1).Select ' debug
LastRow = dataImpSht.Cells(dataImpSht.Rows.Count, "A").End(xlUp).Offset(-1).Row
aCell.Select ' debug
aCell.Offset(0, -1).Select ' debug
aCell.Offset(LastRow, 5).Select ' debug
Set aCell1 = aCell.Offset(0, -1)
Set aCell2 = aCell.Offset(LastRow, 5)
aCell1.Select ' debug
aCell2.Select ' debug
Debug.Print aCell1.FormulaR1C1
Debug.Print aCell2.FormulaR1C1
Set NewRange = dataImpSht.Range(aCell1.Address & ":" & aCell2.Address)
NewRange.Select ' debug
Debug.Print NewRange.Address
NewRange.Interior.ColorIndex = 15
End If
'---------------------------------------------------------------------------
' check this out ... it may be what you need to use
Dim aaa As Range
Set aaa = dataImpSht.Cells(dataImpSht.Rows.Count, "A").End(xlUp).Offset(1)
aaa.Select
aaa.Range("a1").Select ' aaa can be thought off as the new top left corner
aaa.Range("b2").Select ' you can refer to cells in relation to aaa
Set aaa = aaa.Offset(4) ' and move position of aaa for each iteration
aaa.Range("a1").Select
aaa.Range("b2").Select
'---------------------------------------------------------------------------
End Sub
You need to change LastRow to the following as all you need is the row number:
LastRow = Worksheets("Data Importation Sheet").Cells(Rows.Count, "A").End(xlUp).Row - 1

Find particular data and copy the contents till the row ends

I have maintained two Excel reports EPC1.xlsx and Control Power Transformers.xlsm respectively.
I want to trigger an button click from Control Power Transformers.xlsm report where it will search for "CTPT" term in "A" column from EPC1.xlsx, once it finds the term it need to copy Column B and Column c till the row ends (in EPC1.xlsx) and paste it in Control Power Transformers.xlsm workbook
I am successful in retrieving the cell address of "CTPT" term but how to select the data from adjacent column B and C?
And this is what I have tried
Private Sub CommandButton23_Click()
Dim rngX As Range
Dim num As String
Windows("EPC 1.xlsx").Activate
Set rngX = Worksheets("Sheet1").Range("A1:A10000").Find("CTPT", Lookat:=xlPart)
num = rngX.Address ' Here we will the get the cell address of CTPT ($A$14)
Range(rngX, Range("C" & rngX.Row).End(xlDown)).Copy
Windows("Control Power Transformers.xlsm").Activate
Sheets("Sheet2").Select
ActiveSheet.Range("E2").PasteSpecial (xlPasteValues)
End Sub
Paste the below in sample workbook. The below code will help to select both files using file dialog. It will search for word "CTPT". if so it will copy the column values from CTPT sheet to control file.
Sub DetailsFilePath()
Dim File1 As String
Dim File2 As String
Dim findtext As String
Dim copyvalues As Long
Dim c As Variant
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim ws1 As Worksheet
Dim ws2 As Worksheet
MsgBox "Open the CTPT file"
Application.FileDialog(msoFileDialogFilePicker).Show
'On Error Resume Next
' open the file
File1 = Application.FileDialog(msoFileDialogFilePicker).SelectedItems(1)
MsgBox "Open the Control Power Transformers file"
Application.FileDialog(msoFileDialogFilePicker).Show
File2 = Application.FileDialog(msoFileDialogFilePicker).SelectedItems(1)
Set wb1 = Workbooks.Open(Filename:=File1)
Set ws1 = wb1.Worksheets("sheet1")
Set wb2 = Workbooks.Open(Filename:=File2)
Set ws2 = wb2.Worksheets("sheet1")
findtext = "CTPT"
With ws1.Columns(1)
Set c = .Find(findtext, LookIn:=xlValues)
If Not c Is Nothing Then
copyvalues = c.Column
ws2.Columns(2).Value = ws1.Columns(2).Value
ws2.Columns(3).Value = ws1.Columns(3).Value
End If
End With
wb1.Close savechanges:=True
wb2.Close savechanges:=True
End Sub
You need to use FindNext to find other results, and the Offset will help you select what you want from the address of your results :
Sub test_Karthik()
Dim WbEPC As Workbook, _
WbCPT As Workbook, _
WsEPC As Worksheet, _
WsCPT As Worksheet, _
FirstAddress As String, _
WriteRow As Long, _
cF As Range, _
num As String
Set WbEPC = Workbooks("EPC 1.xlsx")
Set WbCPT = Workbooks("Control Power Transformers.xlsm")
Set WsEPC = WbEPC.Sheets("Sheet1")
Set WsCPT = WbCPT.Sheets("Sheet2")
With WsEPC
.Activate
With .Range("A1:A10000")
'First, define properly the Find method
Set cF = .Find(What:="CTPT", _
After:=ActiveCell, _
LookIn:=xlValues, _
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
num = cF.Address ' Here we will the get the cell address of CTPT ($A$14)
WsEPC.Range(cF.Offset(0, 1), cF.Offset(0, 2).End(xlDown)).Copy
WriteRow = WsCPT.Range("E" & WsCPT.Rows.count).End(xlUp).Row + 1
WsCPT.Range("E" & WriteRow).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 With
End Sub

insert a value based on certain criteria in attendance sheet

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

Select a column based on various possible header names

What's the most efficient way of selecting a column based on a variety of different possible header names? For example, the following gives me the column with header "school":
Rows("1:1").Select
Selection.Find(What:="School", _
After:=ActiveCell, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False).Activate
ActiveCell.Select
Range(ActiveCell, ActiveCell.Offset(6536, 0)).Select
However, "school" could be "college" in another workbook, or "institution" in another. Should I just place the above code within an if-then-else statement and replace "school" with the other possibilities, or is there a more efficient way? And yes, this assumes that none of the possible header names co-exist within the same workbook.
Find is already very efficient. What's not efficient is all those Select's.
I suggest you wrap your Find Header logic into a Function, and refactor your code to avoid Select.
Private Function GetColumn(Header() As Variant, _
Optional NumRows As Long = 0, _
Optional ws As Worksheet = Nothing, _
Optional wb As Workbook = Nothing) As Range
Dim rng As Range, cl As Range
Dim i As Long
If wb Is Nothing Then
Set wb = ActiveWorkbook
End If
If ws Is Nothing Then
Set ws = wb.ActiveSheet
End If
Set rng = ws.UsedRange.Rows(1)
For i = LBound(Header) To UBound(Header)
Set cl = rng.Find(What:=Header(i), _
After:=rng.Cells(1, 1), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not cl Is Nothing Then
With ws
If NumRows = 0 Then
Set GetColumn = Range(cl, .Cells(.Rows.Count, cl.Column).End(xlUp))
Else
Set GetColumn = Range(cl, .Cells(NumRows, cl.Column))
End If
Exit Function
End With
End If
Next
Set GetColumn = Nothing
End Function
Call it like this
Dim rng As Range
Dim Headers() As Variant
Headers = Array("School", "Institution", "College")
' Active Workbook, Active Sheet
Set rng = GetColumn(Headers, 6536)
' All rows in specified column
' Specified sheet in Active workbook
Set rng = GetColumn(Headers, , Worksheets("SomeSheetName"))

Search for multiple strings in multiple workbooks at the same time

How can I search for several strings automatically? The number of strings is variable, and are in column A, Sheet “Plan1”, workbook “"Book1.xlsm". I used Find Method for search and a Input Box to find the string, one by one, in a looping for multiple worbooks. I would like to substitute this Input Box to a loop through the strings. Part of my code:
Dim wb As Workbook
Dim SearchString As String
Dim SearchRange As Range, cl As Range
Dim Escolhe_Cor As String
Dim FirstFound As String
Dim ws As Worksheet
str = InputBox("Digite o número a ser procurado")
Escolhe_Cor = InputBox("Escolha uma cor para destacar esse número. De 3 a 56")
Application.FindFormat.Clear
SearchString = Trim(str)
For Each wb In Workbooks
If wb.Name <> "Book1.xlsm" Then
wb.Activate
If Len(SearchString) = "8" Then
For Each ws In ActiveWorkbook.Worksheets
' Find first instance on sheet
Set cl = ws.Cells.Find(What:=SearchString, _
After:=ws.Cells(1, 1), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
If Not cl Is Nothing Then
' if found, remember location
FirstFound = cl.Address
' format found cell
Do 'etc etc
Try below code :
Dim wb As Workbook
Dim SearchString As String
Dim SearchRange As Range, cl As Range
Dim Escolhe_Cor As String
Dim FirstFound As String
Dim ws As Worksheet
Dim searchRng As Range, lastRow As Long, cell As Range
Dim lastRow As Long
lastRow = Workbooks("Book1.xlsm").Sheets("Plan1").Range("65000").End(xlUp).Row
Set searchRng = Workbooks("Book1.xlsm").Sheets("Plan1").Range("A2:A" & lastRow) '
For Each cell In searchRng
SearchString = Trim(cell)
For Each wb In Workbooks
If wb.Name <> "Book1.xlsm" Then
wb.Activate
If Len(SearchString) = "8" Then
For Each ws In ActiveWorkbook.Worksheets
' Find first instance on sheet
Set cl = ws.Cells.Find(What:=SearchString, _
After:=ws.Cells(1, 1), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
If Not cl Is Nothing Then
' if found, remember location
FirstFound = cl.Address