Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Where to insert code?
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Where to insert code?
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 -- - K Dales "Ann" wrote: 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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Where to insert code?
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 |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Where to insert code?
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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Insert Code | Excel Worksheet Functions | |||
insert vba code to new workbook | Excel Worksheet Functions | |||
How to insert code | Excel Discussion (Misc queries) | |||
Insert Code | New Users to Excel | |||
code to insert add'l code ??? | Excel Programming |