A
Annie Oakley
This code was written for me, it works great but I need to make an
addition and can't reach the original author. I am not a great
programmer and can't fix it myself.
I have an Excel file with 2000+ account numbers that I am searching for
in a folder with Excel workbooks. I get back a "Yes" if it is found and
a "No" if it's not.
It is working great, except some of the files have worksheets with
Text Boxes on them, and the account # has been entered into the text
box -
and the macro won't find it there. Is there any change that can be made
to
also search within the text boxes?
Thanks!
Ann
Macro:
Code:
--------------------
Sub FastAcNos()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim tbox As TextBox
Dim AcNo As String
Dim eAc As Long
Dim i As Long
Dim sh As Long
Dim fndAc As Range
On Error Goto Errorhandler
Application.ScreenUpdating = False
eAc = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder("c:\Documents and Settings" & _
"\zzfy98\My Documents\Test") 'change directory
For Each objFile In objFolder.Files
If objFile.Type = "Microsoft Excel Worksheet" Then
Workbooks.Open Filename:=objFolder.Path _
& "\" & objFile.Name, UpdateLinks:=False
With Workbooks(objFile.Name)
For sh = 1 To .Sheets.Count
bDone = True
For i = 1 To eAc
If LCase(ThisWorkbook.Sheets("Sheet1") _
.Cells(i, 2).Value) <> "yes" Then
' All accounts not found
bDone = False
AcNo = ThisWorkbook.Sheets("Sheet1").Cells(i, 1).Value
With .Sheets(sh).Cells
Set fndAc = .Find(AcNo _
, LookIn:=xlValues _
, Lookat:=xlPart _
, MatchCase:=True)
End With
If Not fndAc Is Nothing Then
ThisWorkbook.Sheets("Sheet1"). _
Cells(i, 2).Value = "Yes"
End If
End If
Next i
If bDone Then
.Close False
Exit Sub
End If
Next sh
.Close False
Set objFile = Nothing
End With
End If
Next
For i = 1 To eAc
With ThisWorkbook.Sheets("sheet1")
If IsEmpty(.Cells(i, 2)) Then
.Cells(i, 2).Value = "No"
End If
End With
Next
Errorhandler:
Application.ScreenUpdating = True
Set objFSO = Nothing
Set objFolder = Nothing
Set objFile = Nothing
End Sub
addition and can't reach the original author. I am not a great
programmer and can't fix it myself.
I have an Excel file with 2000+ account numbers that I am searching for
in a folder with Excel workbooks. I get back a "Yes" if it is found and
a "No" if it's not.
It is working great, except some of the files have worksheets with
Text Boxes on them, and the account # has been entered into the text
box -
and the macro won't find it there. Is there any change that can be made
to
also search within the text boxes?
Thanks!
Ann
Macro:
Code:
--------------------
Sub FastAcNos()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim tbox As TextBox
Dim AcNo As String
Dim eAc As Long
Dim i As Long
Dim sh As Long
Dim fndAc As Range
On Error Goto Errorhandler
Application.ScreenUpdating = False
eAc = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder("c:\Documents and Settings" & _
"\zzfy98\My Documents\Test") 'change directory
For Each objFile In objFolder.Files
If objFile.Type = "Microsoft Excel Worksheet" Then
Workbooks.Open Filename:=objFolder.Path _
& "\" & objFile.Name, UpdateLinks:=False
With Workbooks(objFile.Name)
For sh = 1 To .Sheets.Count
bDone = True
For i = 1 To eAc
If LCase(ThisWorkbook.Sheets("Sheet1") _
.Cells(i, 2).Value) <> "yes" Then
' All accounts not found
bDone = False
AcNo = ThisWorkbook.Sheets("Sheet1").Cells(i, 1).Value
With .Sheets(sh).Cells
Set fndAc = .Find(AcNo _
, LookIn:=xlValues _
, Lookat:=xlPart _
, MatchCase:=True)
End With
If Not fndAc Is Nothing Then
ThisWorkbook.Sheets("Sheet1"). _
Cells(i, 2).Value = "Yes"
End If
End If
Next i
If bDone Then
.Close False
Exit Sub
End If
Next sh
.Close False
Set objFile = Nothing
End With
End If
Next
For i = 1 To eAc
With ThisWorkbook.Sheets("sheet1")
If IsEmpty(.Cells(i, 2)) Then
.Cells(i, 2).Value = "No"
End If
End With
Next
Errorhandler:
Application.ScreenUpdating = True
Set objFSO = Nothing
Set objFolder = Nothing
Set objFile = Nothing
End Sub