G
Guest
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
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