ThisWorkbook Problem
 

I have the following code in a file (call it File1) which SHOULD do the
following: Prompt a user to select a file (call it FileMMS), then open
FileMMS, copy certain data from that file into the original (active) file
(File1), and then close FileMMS. Problem is this:

I open File1 and run the macro, it works fine. I then open another copy of
File1 (under a different filename - call this File2) and run the macro, it
works fine. With both of these files open, I go back to File1 and run the
macro again; instead of putting the extracted data (from FileMMS) into File1
however, it puts it into File2. It needs to put the data into whatever file
is active at the time, so it seems my code has a problem in terms of
recognizing in which workbook to put the data (it should be the active
workbook). Would appreciate some assistance in correcting this - is probably
a one-liner thing but I can't figure it out. The code is:

Sub GetDataFromMMSForm()
Dim WB As Workbook
Dim strFileName As String
Dim P As Variant
Dim X As Variant
Dim rFound As Range

strFileName = Application.GetOpenFilename(FileFilter:="All
Files(*.*),*.xls,All Files (*.*),*.*")

On Error Resume Next
Set WB = Workbooks(Mid(strFileName, InStrRev(strFileName, "\") + 1, 256))
On Error GoTo 0

If WB Is Nothing Then
Set WB = Workbooks.Open(strFileName, True, True)
On Error Resume Next
Worksheets("A").Select
Set rFound = Cells.Find(What:="Customer Name =", After:=Range("A1"), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows,
SearchDirection:=xlNext, MatchCase:=False)
If rFound Is Nothing Then
MsgBox "Sorry; Excel was unable to find a customer name."
Else
With ThisWorkbook.Worksheets("Schedule")
.Range("B6").Value = Range(rFound.Address).Offset(0,
1).Value
End With
End If
On Error GoTo 0
WB.Close False
Set WB = Nothing

Else

Set WB = Workbooks(Mid(strFileName, InStrRev(strFileName, "\") + 1, 256))
On Error Resume Next

WB.Worksheets("A").Activate
Set rFound = Cells.Find(What:="Customer Name =", After:=Range("A1"), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows,
SearchDirection:=xlNext, MatchCase:=False)
If rFound Is Nothing Then
MsgBox "Sorry; Excel was unable to find a customer name."
Else
With ThisWorkbook.Worksheets("Schedule")
.Range("B6").Value = Range(rFound.Address).Offset(0,
1).Value
End With
End If

On Error GoTo 0
Set WB = Nothing
End If

ThisWorkbook.Activate
Range("A1").Select
End Sub

ThisWorkbook Problem
 

You only have 1 object reference to a workbook (WB). You need to set up
your code to have 2 object references, like the following. Note that I
check to see what value is returned from the GetOpenFilename method (the
user may have cancelled out of the dialog box, so GetOpenFilename would be
a Boolean and would be False).

'----------------------------------------------------------------------
Sub GetDataFromMMSForm()
Dim wbMain As Workbook
Dim wbMMSData As Workbook
Dim varMMSFileName As Variant

Set wbMain = ActiveWorkbook 'Workbook compiling all the data.

'Prompt for and open MMSData workbook.
GetOpenFilename = Application.GetOpenFilename()

If VarType(varMMSFileName) = vbString _
Then
'Do processing and close MMSData workbook.

'Else user canceled out of the File Open dialog box.
End If

'wbMain.Save
'or
'wbMain.Close SaveChanges:=True
End Sub

--
Regards,
Bill Renaud

ThisWorkbook Problem
 

I would recommend that you remove your code from File1 and File2, and keep
it in a separate workbook (code only) with a button somewhere (on a
CommandBar or Ribbon now in Excel 2007?). You probably should add some code
to figure out which workbook is which when setting the references. I know
this involves some work, but it will make your code more robust.

You are welcome to use the following code, which I quickly copied from a
project that I did several years ago. The main routine (not listed here)
calls LocateDataWB (and a similar routine for the other workbook), which
returns TRUE if the data workbook (wbData) is open. A workbook is
considered open if any window is visible (not just the first one) and if it
is a valid data workbook (the IsDataWB function). You will have to write
your own version of the IsDataWB function (look for certain worksheets in
the workbook, look for certain values on certain worksheets, etc.). In this
fashion, your code is not dependent on which workbook is active at the time
the macro starts.

HTH!

'--------------------------------------------------------------------------
------
'LocateDataWB returns TRUE if a source workbook of RRF data is found and
visible.
'wbData is set to the workbook, if found, Nothing otherwise.
'
Function LocateDataWB(wbData As Workbook) As Boolean
Dim wb As Workbook

'Iterate through all open workbooks and locate the first visible Data
workbook.
For Each wb In Workbooks
If IsWBVisible(wb) _
Then
If IsDataWB(wb) _
Then
'wb is a valid input data workbook.
Set wbData = wb
LocateDataWB = True
Exit Function
End If 'IsDataWB(wb)
End If 'IsWBVisible(wb)
Next wb

'All open workbooks checked, no data workbook was found!
Set wbData = Nothing
LocateDataWB = False
MsgBox "No open and visible data workbook was found.", _
vbCritical + vbOKOnly, "Load RRF Data"
End Function

'--------------------------------------------------------------------------
------
'IsDataWB returns TRUE if the workbook is a data workbook.
'A valid data workbook must have a sheet named "Summary"
'and have the text string "RRF Analysis" in cell $A$1.

Function IsDataWB(wb As Workbook) As Boolean
On Error GoTo NoDataWB

IsDataWB = (wb.Sheets("Summary").Range("A1").Value = "RRF Analysis")

Exit Function

NoDataWB:
IsDataWB = False
End Function

'--------------------------------------------------------------------------
------
'IsWBVisible returns TRUE if any window for this workbook is visible.

Function IsWBVisible(wb As Workbook) As Boolean
Dim wnd As Long

For wnd = 1 To wb.Windows.Count
If wb.Windows(wnd).Visible _
Then
IsWBVisible = True
Exit Function
End If
Next wnd

IsWBVisible = False
End Function

--
Regards,
Bill Renaud

ThisWorkbook Problem
 

When working with multiple Workbooks you want to be very explicit in your
referencing. Otherwise default referencing will be the order of the day and
that is not always what you might think it is... Give this a look...

Sub GetDataFromMMSForm()
Dim wbkMMS As Workbook
Dim wksMMS As Worksheet
Dim strFileName As String
Dim P As Variant
Dim X As Variant
Dim rFound As Range

strFileName = Application.GetOpenFilename(FileFilter:="AllFiles( *.*), "
& _
"*.xls,All Files (*.*),*.*")

On Error Resume Next
Set wbkMMS = Workbooks(Mid(strFileName, InStrRev(strFileName, "\") + 1,
256))
On Error GoTo 0

If wbkMMS Is Nothing Then
Set wbkMMS = Workbooks.Open(strFileName, True, True)
End If

On Error Resume Next
Set wksMMS = wbkMMS.Worksheets("A")
Set rFound = wksMMS.Cells.Find(What:="Customer Name =", _
After:=Range("A1"), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If rFound Is Nothing Then
MsgBox "Sorry; Excel was unable to find a customer name."
Else
ThisWorkbook.Worksheets("Schedule").Range("B6").Va lue =
rFound.Offset(0, 1).Value
End If

ThisWorkbook.Activate
Range("A1").Select
End Sub
--
HTH...

Jim Thomlinson


"Paige" wrote:

I have the following code in a file (call it File1) which SHOULD do the
following: Prompt a user to select a file (call it FileMMS), then open
FileMMS, copy certain data from that file into the original (active) file
(File1), and then close FileMMS. Problem is this:

I open File1 and run the macro, it works fine. I then open another copy of
File1 (under a different filename - call this File2) and run the macro, it
works fine. With both of these files open, I go back to File1 and run the
macro again; instead of putting the extracted data (from FileMMS) into File1
however, it puts it into File2. It needs to put the data into whatever file
is active at the time, so it seems my code has a problem in terms of
recognizing in which workbook to put the data (it should be the active
workbook). Would appreciate some assistance in correcting this - is probably
a one-liner thing but I can't figure it out. The code is:

Sub GetDataFromMMSForm()
Dim WB As Workbook
Dim strFileName As String
Dim P As Variant
Dim X As Variant
Dim rFound As Range

strFileName = Application.GetOpenFilename(FileFilter:="All
Files(*.*),*.xls,All Files (*.*),*.*")

On Error Resume Next
Set WB = Workbooks(Mid(strFileName, InStrRev(strFileName, "\") + 1, 256))
On Error GoTo 0

If WB Is Nothing Then
Set WB = Workbooks.Open(strFileName, True, True)
On Error Resume Next
Worksheets("A").Select
Set rFound = Cells.Find(What:="Customer Name =", After:=Range("A1"), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows,
SearchDirection:=xlNext, MatchCase:=False)
If rFound Is Nothing Then
MsgBox "Sorry; Excel was unable to find a customer name."
Else
With ThisWorkbook.Worksheets("Schedule")
.Range("B6").Value = Range(rFound.Address).Offset(0,
1).Value
End With
End If
On Error GoTo 0
WB.Close False
Set WB = Nothing

Else

Set WB = Workbooks(Mid(strFileName, InStrRev(strFileName, "\") + 1, 256))
On Error Resume Next

WB.Worksheets("A").Activate
Set rFound = Cells.Find(What:="Customer Name =", After:=Range("A1"), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows,
SearchDirection:=xlNext, MatchCase:=False)
If rFound Is Nothing Then
MsgBox "Sorry; Excel was unable to find a customer name."
Else
With ThisWorkbook.Worksheets("Schedule")
.Range("B6").Value = Range(rFound.Address).Offset(0,
1).Value
End With
End If

On Error GoTo 0
Set WB = Nothing
End If

ThisWorkbook.Activate
Range("A1").Select
End Sub

ThisWorkbook Problem
 

Thanks, Jim and Bill, for your responses. Will work on this to get it fixed
properly!

"Jim Thomlinson" wrote:

When working with multiple Workbooks you want to be very explicit in your
referencing. Otherwise default referencing will be the order of the day and
that is not always what you might think it is... Give this a look...

Sub GetDataFromMMSForm()
Dim wbkMMS As Workbook
Dim wksMMS As Worksheet
Dim strFileName As String
Dim P As Variant
Dim X As Variant
Dim rFound As Range

strFileName = Application.GetOpenFilename(FileFilter:="AllFiles( *.*), "
& _
"*.xls,All Files (*.*),*.*")

On Error Resume Next
Set wbkMMS = Workbooks(Mid(strFileName, InStrRev(strFileName, "\") + 1,
256))
On Error GoTo 0

If wbkMMS Is Nothing Then
Set wbkMMS = Workbooks.Open(strFileName, True, True)
End If

On Error Resume Next
Set wksMMS = wbkMMS.Worksheets("A")
Set rFound = wksMMS.Cells.Find(What:="Customer Name =", _
After:=Range("A1"), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If rFound Is Nothing Then
MsgBox "Sorry; Excel was unable to find a customer name."
Else
ThisWorkbook.Worksheets("Schedule").Range("B6").Va lue =
rFound.Offset(0, 1).Value
End If

ThisWorkbook.Activate
Range("A1").Select
End Sub
--
HTH...

Jim Thomlinson


"Paige" wrote:

I have the following code in a file (call it File1) which SHOULD do the
following: Prompt a user to select a file (call it FileMMS), then open
FileMMS, copy certain data from that file into the original (active) file
(File1), and then close FileMMS. Problem is this:

I open File1 and run the macro, it works fine. I then open another copy of
File1 (under a different filename - call this File2) and run the macro, it
works fine. With both of these files open, I go back to File1 and run the
macro again; instead of putting the extracted data (from FileMMS) into File1
however, it puts it into File2. It needs to put the data into whatever file
is active at the time, so it seems my code has a problem in terms of
recognizing in which workbook to put the data (it should be the active
workbook). Would appreciate some assistance in correcting this - is probably
a one-liner thing but I can't figure it out. The code is:

Sub GetDataFromMMSForm()
Dim WB As Workbook
Dim strFileName As String
Dim P As Variant
Dim X As Variant
Dim rFound As Range

strFileName = Application.GetOpenFilename(FileFilter:="All
Files(*.*),*.xls,All Files (*.*),*.*")

On Error Resume Next
Set WB = Workbooks(Mid(strFileName, InStrRev(strFileName, "\") + 1, 256))
On Error GoTo 0

If WB Is Nothing Then
Set WB = Workbooks.Open(strFileName, True, True)
On Error Resume Next
Worksheets("A").Select
Set rFound = Cells.Find(What:="Customer Name =", After:=Range("A1"), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows,
SearchDirection:=xlNext, MatchCase:=False)
If rFound Is Nothing Then
MsgBox "Sorry; Excel was unable to find a customer name."
Else
With ThisWorkbook.Worksheets("Schedule")
.Range("B6").Value = Range(rFound.Address).Offset(0,
1).Value
End With
End If
On Error GoTo 0
WB.Close False
Set WB = Nothing

Else

Set WB = Workbooks(Mid(strFileName, InStrRev(strFileName, "\") + 1, 256))
On Error Resume Next

WB.Worksheets("A").Activate
Set rFound = Cells.Find(What:="Customer Name =", After:=Range("A1"), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows,
SearchDirection:=xlNext, MatchCase:=False)
If rFound Is Nothing Then
MsgBox "Sorry; Excel was unable to find a customer name."
Else
With ThisWorkbook.Worksheets("Schedule")
.Range("B6").Value = Range(rFound.Address).Offset(0,
1).Value
End With
End If

On Error GoTo 0
Set WB = Nothing
End If

ThisWorkbook.Activate
Range("A1").Select
End Sub