I have been trying to write this macro for quite some time now. I've received
much help already but keep getting stuck. I'm just going to lay it out and
maybe someone knows how the code will work?

I have files for different services, and for every year there is the same
service with different data. Therefore, there are folders for every year, and
in them the different kinds of service. I need to compare the data from two
years for the same service. The problem is, the service files have all the
same name for each year, i.e. 'Service 1' in 2001 and 'Service 1' in 2000. I
want to be able to open up excel and import my macro. I then want it to
prompt for the file name (what service) and what two years it wants to
compare. I know it cant have the same file name open at a time for two
different files, so i want to be able to copy and paste the worksheet into
the excel file i have open, then close and then open the second year's file.

I am having so much trouble getting these files to open. If anyone can help
it would be greatly appreciated.


MSHO

Can we assume that there's only one worksheet in each workbook?
--
Gary Brown


"MSHO" wrote:

I have been trying to write this macro for quite some time now. I've received
much help already but keep getting stuck. I'm just going to lay it out and
maybe someone knows how the code will work?

I have files for different services, and for every year there is the same
service with different data. Therefore, there are folders for every year, and
in them the different kinds of service. I need to compare the data from two
years for the same service. The problem is, the service files have all the
same name for each year, i.e. 'Service 1' in 2001 and 'Service 1' in 2000. I
want to be able to open up excel and import my macro. I then want it to
prompt for the file name (what service) and what two years it wants to
compare. I know it cant have the same file name open at a time for two
different files, so i want to be able to copy and paste the worksheet into
the excel file i have open, then close and then open the second year's file.

I am having so much trouble getting these files to open. If anyone can help
it would be greatly appreciated.


MSHO

Yes there is only one worksheet in the file.

"MSHO" wrote:

I have been trying to write this macro for quite some time now. I've received
much help already but keep getting stuck. I'm just going to lay it out and
maybe someone knows how the code will work?

I have files for different services, and for every year there is the same
service with different data. Therefore, there are folders for every year, and
in them the different kinds of service. I need to compare the data from two
years for the same service. The problem is, the service files have all the
same name for each year, i.e. 'Service 1' in 2001 and 'Service 1' in 2000. I
want to be able to open up excel and import my macro. I then want it to
prompt for the file name (what service) and what two years it wants to
compare. I know it cant have the same file name open at a time for two
different files, so i want to be able to copy and paste the worksheet into
the excel file i have open, then close and then open the second year's file.

I am having so much trouble getting these files to open. If anyone can help
it would be greatly appreciated.


MSHO

This may help.

Option Explicit

Sub Test()

Dim wsWorksheet As Worksheet
Dim wbWorkbook As Workbook

Set wsWorksheet = ActiveSheet

Set wbWorkbook = Workbooks.Open("C:\Temp\Sub1\Test.xls")
wbWorkbook.Worksheets("Sheet1").Copy After:=wsWorksheet
wbWorkbook.Close SaveChanges:=False

Set wbWorkbook = Workbooks.Open("C:\Temp\Sub2\Test.xls")
wbWorkbook.Worksheets("Sheet1").Copy After:=wsWorksheet
wbWorkbook.Close SaveChanges:=False

End Sub




*** Sent via Developersdex http://www.developersdex.com ***

Here's a macro that I cut and pasted to hopefully fit your needs. Copy this
into a new module.
The macro that should be run is "GetFiles'.
The rest are functions to get various information.

'=== START OF MACRO TO BE COPIED========
'/======================================/
'The purpose of this 'GetFiles' macro is to Select a file, then
' select the folder of the second file with the same name, then
' copy both files to a new workbook
'
'/======================================/
'32-bit API declarations
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, _
ByVal pszPath As String) As Long

Private Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) _
As Long
'/======================================/
Private Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
'/======================================/
Sub GetFiles()
Dim strFirstFile As String, str2ndFolder As String
Dim strFileNameOnly As String, str1stFolder As String
Dim strNewWorkbookName As String, strNewUnNamedWorkbook As String

On Error GoTo err_Sub

'default new workbook name
strNewWorkbookName = "Compare_" & Now()

'get first file to be opened
strFirstFile = GetFirstFileName

'get folder of 2nd file
str2ndFolder = _
GetDirectory("Select Folder location of 2nd file") & "\"

'Get name of file to be imported
strFileNameOnly = GetFileNameOnly(strFirstFile)

'get name of first folder
str1stFolder = GetFirstFolderName(strFirstFile)

'check that 2nd file exists
If FileExists(str2ndFolder & strFileNameOnly) = False Then
MsgBox str1stFolder & strFileNameOnly & " does NOT exist." & _
vbCr & "Process halted", vbCritical + vbOKOnly, "Warning..."
GoTo exit_Sub
End If

'Add a new workbook
Workbooks.Add
strNewUnNamedWorkbook = _
Application.ActiveWorkbook.Name

'open 1st file
Application.Workbooks.Open strFirstFile

'copy to new workbook
Application.ActiveSheet.Copy _
Befo=Workbooks(strNewUnNamedWorkbook).Sheets(1)

'close the 1st file
Windows(strFileNameOnly).Activate
Application.ActiveWorkbook.Close SaveChanges:=False

'open 2nd file
Application.Workbooks.Open str2ndFolder & strFileNameOnly

'copy to new workbook
Application.ActiveSheet.Copy _
Befo=Workbooks(strNewUnNamedWorkbook).Sheets(2)

'close the 2nd file
Windows(strFileNameOnly).Activate
Application.ActiveWorkbook.Close SaveChanges:=False

'goto the new workbook
Windows(strNewUnNamedWorkbook).Activate

exit_Sub:
On Error Resume Next
Exit Sub

err_Sub:
MsgBox "Error has occurred: " & Err.Number & " - " & _
Err.Description
GoTo exit_Sub

End Sub
'/======================================/
Private Function GetFirstFolderName(strName As String) As String
Dim i As Integer

GetFirstFolderName = ""

If Len(strName) 0 Then
For i = Len(strName) To 1 Step -1
If Mid(strName, i, 1) = "\" Then
GetFirstFolderName = Left(strName, i)
Exit Function
End If
Next i
End If

End Function
'/======================================/
Private Function GetFileNameOnly(strName As String) As String
Dim i As Integer

GetFileNameOnly = ""

If Len(strName) 0 Then
For i = Len(strName) To 1 Step -1
If Mid(strName, i, 1) = "\" Then
GetFileNameOnly = Right(strName, Len(strName) - i)
Exit Function
End If
Next i
End If

End Function
'/======================================/
Private Function GetFirstFileName() As String
Dim iFilterIndex As Integer
Dim strFilter As String, StrDialogBoxTitle As String
Dim varFileName As Variant

strFilter = "Excel Files (*.xl?),*.xl?," & _
"Comma Separated Files (*.csv),*.csv," & _
"Text_1 Files (*.txt),*.txt," & _
"Text_2 Files (*.prn),*.prn," & _
"All Files (*.*), *.*"

varFileName = ""

'Display Excel Files as default - 1st on StrFilter list above
iFilterIndex = 1

'Set the dialog box caption
StrDialogBoxTitle = "Select First File to Open"

'Get the File Name
varFileName = _
Application.GetOpenFilename(fileFilter:=strFilter, _
FilterIndex:=iFilterIndex, Title:=StrDialogBoxTitle)

If varFileName = False Then
varFileName = ""
End If

GetFirstFileName = varFileName

End Function
'/======================================/
Private Function GetDirectory(Optional Msg) As String
Dim bInfo As BROWSEINFO
Dim iFileSystemDirectoriesOnly As Long
Dim iDialogType As Long
Dim iBrowseForComputers As Long
Dim iBrowseForPrinters As Long
Dim iBrowseIncludesFiles As Long
Dim Path As String
Dim r As Long, x As Long, Pos As Integer

iFileSystemDirectoriesOnly = 0
iDialogType = 0
iBrowseForComputers = 0
iBrowseForPrinters = 0
iBrowseIncludesFiles = 0
'- - - - - - - - - - - - - - - - -
' Only return file system directories.
iFileSystemDirectoriesOnly = &H1
' Dialog style with context menu and resizability
' iDialogType = &H40
' Only returns computers
' iBrowseForComputers = &H1000
' Only return printers
' iBrowseForPrinters = &H2000
' The browse dialog will display files as well as folders
' iBrowseIncludesFiles = &H4000

' Root folder = Desktop
bInfo.pidlRoot = 0&

' Title in the dialog
If IsMissing(Msg) Then
bInfo.lpszTitle = "Select a folder."
Else
bInfo.lpszTitle = Msg
End If

' Type of directory to return
' bInfo.ulFlags = &H1
bInfo.ulFlags = _
iFileSystemDirectoriesOnly + _
iDialogType + _
iBrowseForComputers + _
iBrowseForPrinters + _
iBrowseIncludesFiles

' Display the dialog
x = SHBrowseForFolder(bInfo)

' Parse the result
Path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal Path)
If r Then
Pos = InStr(Path, Chr$(0))
GetDirectory = Left(Path, Pos - 1)
Else
GetDirectory = ""
End If
End Function
'/======================================/
Private Function FileExists(strFileName As String) _
As Boolean
FileExists = False
If Dir(strFileName) < "" Then
FileExists = True
End If
End Function
'/======================================/
'=== END OF MACRO TO BE COPIED========


HTH,
--
Gary Brown

If this post was helpful, please click the ''Yes'' button next to ''Was this
Post Helpfull to you?''.