Where to insert code?

A

Ann

I am using some VBA to search for a list of Account #'s in other Excel files.
Works great as it is (listed below) - but some of the data has been entered
in Text Boxes over the Excel spreadsheets. I want to be able to search BOTH
the Excel cells and any Text Boxes for the Account #. I was given this code
by Tom Ogilvy (Thanks, Tom!):

Dim tbox as Textbox

for each tbox in .sheets(sh).Textboxes
if instr(1,AcNo,tbox.Text,vbTextcompare) then
' AcNo found

end if
Next

Where do I put it into this original 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
 
K

K Dales

Looks to me like this is where you are searching the cells for the account
number - yes/no? If yes then see my additions:

AcNo = ThisWorkbook.Sheets("Sheet1").Cells(i, 1).Value
With .Sheets(sh).Cells
Set fndAc = .Find(AcNo _
, LookIn:=xlValues _
, Lookat:=xlPart _
, MatchCase:=True)
End With

'NOTE: code below checks to see if you found it in a cell (Not fndAc Is
Nothing)
' So we need an ELSE clause to check the text boxes if it has NOT been found
yet:

If Not fndAc Is Nothing Then
ThisWorkbook.Sheets("Sheet1"). _
Cells(i, 2).Value = "Yes"
Else
' Tom's Code:
For each tbox in .sheets(sh).Textboxes
If instr(1,AcNo,tbox.Text,vbTextcompare) then
' AcNo found
ThisWorkbook.Sheets("Sheet1").Cells(i,2).Value = "Yes" ' I
assume???
End if
Next tbox

End If
 
A

Ann

HELP!! It's not working! It just stops in the middle of the file, no results.
This is what I have now:

Sub FastAcNos()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim AcNo As String
Dim eAc As Long
Dim i As Long
Dim sh As Long
Dim fndAc As Range
Dim tbox As TextBox

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"
Else
' Tom's Code:
For Each tbox In .Sheets(sh).TextBoxes
If InStr(1, AcNo, tbox.Text, vbTextCompare) Then
' AcNo found
ThisWorkbook.Sheets("Sheet1").Cells(i, 2).Value = "Yes" ' I
assume???
End If
Next

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
 
A

Ann

Whoops! That should be:
It still stops in the middle of the file!

Sub FastAcNos()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim AcNo As String
Dim eAc As Long
Dim i As Long
Dim sh As Long
Dim fndAc As Range
Dim tbox As TextBox

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"
Else
' Tom's Code:
For Each tbox In .Sheets(sh).TextBoxes
If InStr(1, AcNo, tbox.Text, vbTextCompare) Then
' AcNo found
ThisWorkbook.Sheets("Sheet1").Cells(i, 2).Value = "Yes" ' I
assume???
End If
Next tbox

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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Searching Textboxes on worksheets 1
Need More Help for Searching Textboxes 4
Speed up the search? 5
Word macro that can call cells out of Excel for a find and replace 0
Search/Compare VBA Help 3
find newest file in all sub folders 2
Closing PDF file from Excel VBA (Adobe Reader, Adobe Acrobat, Browser) 0
Working outlook via vba code with xlsx - error 0

Top