I've been testing and modifying your sample code. Below is what I currently
have done. However, I cannot get it to loop and open what would be the next
datafile (sName) that needs to be evaluated for a matching tab name. Can you
review my code and let me know what is wrong?
Sub OpenFiles()
'Close all open workbooks without prompting to save changes.
Application.DisplayAlerts = False
Workbooks.Close
Application.DisplayAlerts = True
filetype0 = "*_Filter.XLS"
filetype1 = "???????.XLS"
filterfile = Dir(filetype0)
datafile = Dir(filetype1)
Application.Dialogs(xlDialogOpen).Show
curpath = curdir()
Continue = MsgBox("Is the path displayed above your intended path?",
vbYesNo, "" & curpath & "\" & "")
If Continue = vbYes Then
GoTo Start
Else: End
End If
NoFilesTitle = "No files of type " & filetype0 & " or" & filetype1 & "
in selected directory!"
NoFilesStyle = vbYesNo + vbDefaultButtton2
If filterfile = "" And datafile = "" Then
MsgBox "Either no expected Filter or Data file found in the current
folder."
End
End If
Start:
'A Filter and at least 1 Data file are in the working folder.
Workbooks.OpenText Filename:=filterfile
Dim sh As Worksheet, sh1 As Worksheet
Dim bk As Workbook, bk1 As Workbook
Dim bk2 As Workbook
Dim sName As String
Dim sPath As String
'Dim datafile As Variant
Dim bFound As Boolean
For Each bk1 In Workbooks
' If InStr(1, bk1.Name, "filter.xls", vbTextCompare) Then
If InStr(1, bk1.Name, filterfile, vbTextCompare) Then
Set bk2 = bk1
Exit For
End If
Next
If bk2 Is Nothing Then
MsgBox "Filter workbook not found, exiting."
Exit Sub
End If
sPath = curdir()
'sPath = "C:\Myfiles\"
'sName = Dir(sPath & "Data*.xls")
sName = Dir(sPath & "\" & datafile)
Do While sName <> ""
bFound = False
Set bk = Workbooks.Open(sPath & "\" & sName)
For Each sh In bk.Worksheets
Set sh1 = Nothing
On Error Resume Next
Set sh1 = bk2.Worksheets(Left(sh.Name, 6))
Debug.Print ActiveSheet.Name; Sheet1(2)
Debug.Print Left(ActiveSheet.Name, 6); Sheet1
On Error GoTo 0
If Not sh1 Is Nothing Then
' copy from sh to sh1
bFound = True
MsgBox "Matching sheet found" & " for " & sh.Name & "."
FirstSheet = ActiveSheet.Name
If FirstSheet = "Fill" Then
ActiveSheet.Previous.Select
End If
Cells(2, 1).Select
ActiveCell.End(xlToRight).Select
ActiveCell.End(xlDown).Select
endrow = ActiveCell.Row
endcol = ActiveCell.Column
If endcol > 34 Then
endcol = 34
End If
Range(Cells(2, 1), Cells(endrow, endcol)).Select
Selection.Copy
Windows(filterfile).Activate
Cells(5, 1).Select
ActiveSheet.Paste
ActiveCell.End(xlToRight).Select
ActiveCell.End(xlDown).Select
'The following lines FILL DOWN automatically for the number of
points then
'SELECT the range to be pasted-special-values back into
'the data file.
endrow = ActiveCell.Row
endcol = ActiveCell.Column
Cells(endrow, 37).Select
Range(Cells(endrow, 37), Cells(5, endcol - 3 + 37)).Select
Selection.FillDown
Selection.Copy
'Continue here by pasting the data just filtered/copied then paste it to the
original data file.
Windows(datafile).Activate
Call CellC2.CellC2 'This just pastes the values from the last
Selection.Copy
Else
' matching sheet not found
End If
Next sh
If Not bFound Then
MsgBox "No match found in " & bk.Name
End If
bk.Close Savechanges:=False
sName = Dir()
Loop
End Sub
Tom Ogilvy said:
? activesheet.name
Sheet1 (2)
? left(activesheet.name,6)
Sheet1
returned the leftmost 6 characters of the range.
So, perhaps you have clearly stated the problem.
--
Regards,
Tom Ogilvy
Freddy said:
The following line in your sample does not appear to work:
Set sh1 = bk2.Worksheets(Left(sh.Name, 6))
I am getting returned the entire tab name. Please advise.
Tom Ogilvy said:
Sub OpenFiles()
Dim sh as Worksheet, sh1 as Worksheet
dim bk as Workbook, bk1 as workbook
Dim bk2 as Workbook
Dim sName as String
Dim sPath as String
Dim bFound as Boolean
for each bk1 in workbooks
if instr(1,bk1.name,"filter.xls",vbTextcompare) then
set bk2 = bk1
exit for
end if
Next
if bk2 is nothing then
Msgbox "Filter workbook not found, exiting"
exit sub
end if
sPath = "C:\Myfiles\"
sName = Dir(sPath & "Data*.xls")
do while sName <> ""
bFound = False
set bk = workbooks.open( sPath & sName)
for each sh in bk.worksheets
set sh1 = Nothing
On error resume Next
set sh1 = bk2.Worksheets(left(sh.name,6))
On Error goto 0
if not sh1 is nothing then
' copy from sh to sh1
bFound = True
else
' matching sheet not found
end if
Next sh
If not bFound then
msgbox "No match found in " & bk.name
end if
bk.close Savechanges:=False
sName = dir()
Loop
End Sub
--
Regards,
Tom Ogilvy
:
By the way, the name of the Filter.xls file can vary depending on a
company
name. Can that be incorporated in your sample code? The latter portion
of the
file name will always have _Filter.xls. An example name is
"Company1_Filter.xls".
:
I check for the tab name here: (I try to set a reference to the
sheet - if
unsuccessful, then I know the sheet doesn't exist).
for each sh in bk.worksheets
set sh1 = Nothing
On error resume Next
set sh1 = workbooks("Filter.xls").Worksheets(sh.name)
On Error goto 0
if not sh1 is nothing then
' copy from sh to sh1
bFound = True
else
' matching sheet not found
end if
if the Filter.xls actually has names of 6 characters, then you could
modify
set sh1 = workbooks("Filter.xls").Worksheets(sh.name)
to
set sh1 = workbooks("Filter.xls").Worksheets(left(sh.name,6))
if you are looking for a match on the first 6 characters and both
names are
longer than six characters, then you would have to loop through the
names.
--
Regards,
Tom Ogilvy
:
Tom, knowing that you based your sample code on the information I
supplied, a
new item has come up. I need to store the 6 leftmost characters of
the tab
name in the Data.xls files and use that as a basis to look in the
Filter.xls
file for a matching tab name. Also, I did not detect in your sample
code how
the tab names in the Filter.xls file were being evaluated. Please
review and
advise.
:
the following untested pseudo code should get you started:
Sub OpenFiles()
Dim sh as Worksheet, sh1 as Worksheet
dim bk as Workbook
Dim sName as String
Dim sPath as String
Dim bFound as Boolean
sPath = "C:\Myfiles\"
sName = Dir(sPath & "Data*.xls")
do while sName <> ""
bFound = False
set bk = workbooks.open( sPath & sName)
for each sh in bk.worksheets
set sh1 = Nothing
On error resume Next
set sh1 = workbooks("Filter.xls").Worksheets(sh.name)
On Error goto 0
if not sh1 is nothing then
' copy from sh to sh1
bFound = True
else
' matching sheet not found
end if
Next sh
If not bFound then
msgbox "No match found in " & bk.name
end if
bk.close Savechanges:=False
sName = dir()
Loop
End Sub
--
Regards,
Tom Ogilvy
:
I have a workbook (let's call it Filter.xls) containing several
tabs with
different names, let's say: 111111, 222222, and 333333. The
Filter.xls file
contains formulas which are applied to records of numerical
data obtained
from separate works (let's call them Data1.xls, Data2.xls,
Data3.xls, etc.)
containing several tabs with different names like 111111, xxxx,
222222, xxxx,
333333, xxxx. All aforementioned files would be in the same
working folder.
What I'd like the VBA code to do is to cycle through any
existing
Data[#].xls files and check if there are matching tab names
between them and
the Filter.xls file and, if so, copy the record set from the
matching tab in
the Data[#].xls file to the matching tab in the Filter.xls
file. I already
have code to copy the record set from the Data[#].xls file into
the
Filter.xls file but what I am missing is the code that
determines if there is
a match between the tabs in the Filter.xls file and any
available Data[#].xls
file. If there is no match then notify the user and exit.
I'd appreciate anyone's assistance. Please contact me if you
need further
details.
