Need help copying matching values only to different workbook

Adrae

Active Member
Joined
Feb 19, 2002
Messages
306
Anyone know how to write the description in red below: Thanks!

Sub HC()
Dim UName As String
Dim ce As Range
Application.DisplayAlerts = False
If Application.UserName = "Blah Blah Blah" Then 'BEGIN IF #1
UName = InputBox("Please Enter Your Name")
Else
UName = Application.UserName
End If 'END IF #1
'Following code sets status to Pending
For Each ce In Range("include")
If ce = "x" Then 'BEGIN IF #2
ce.Offset(, 6).Font.ColorIndex = 11
ce.Offset(, 6).Font.Bold = False
ce.Offset(, 6).Value = "Pending"
End If 'END IF #2
Next ce
'End of "Pending" code
'Following code sets status to Updating
For Each ce In Range("include")
If ce = "x" Then 'BEGIN #3 (MAIN IF)
ce.Offset(, 6).Font.ColorIndex = 3
ce.Offset(, 6).Font.Bold = False
ce.Offset(, 6).Value = "Updating"
'End of "Updating" code
Application.ScreenUpdating = False 'turns off screen updating (user cannot see changes being made)
'Following code looks for and opens file based on File name listed
Dim MyPath As String
Dim wbname As String
Dim shname As String
Dim MyRegion As String
Dim MyFolder As String
MyPath = ThisWorkbook.Path
MyRegion = ce.Offset(, -3)
MyFolder = ce.Offset(, -1)
shname = ce.Offset(, -4)
wbname = shname
Application.AskToUpdateLinks = False
Dim Filetest As String
Filetest = Dir(MyPath & "\" & MyFolder & "\" & MyRegion & "\" & shname)
If Filetest = "" Then 'BEGIN IF #4
ce.Offset(, 4).Value = Now
ce.Offset(, 5).Value = UName
ce.Offset(, 6).Font.ColorIndex = 3
ce.Offset(, 6).Font.Bold = True
Application.ScreenUpdating = True
ce.Offset(, 6).Value = "File not Found"
Application.ScreenUpdating = False
Else 'ELSE #4
If WorkbookIsOpen(wbname) = False Then 'BEGIN IF #5
Workbooks.Open Filename:=MyPath & "\" & MyFolder & "\" & MyRegion & "\" & shname, UpdateLinks:=False
'NEED CODE HERE TO SELECT SHEET ("Sheet1") FIND VALUES IN COLUMN L THAT MATCH CE.OFFSET(,1). On Sheet 1, COPY COLUMNS D:G OF MATCHING ROWS ONLY TO WORKBOOK "Test" on Sheet "Sheet2" STATING IN CELL D32.
'Start code to set status to Completed
Sheets("MACRO").Activate
Application.ScreenUpdating = True
ce.Offset(, 4).Value = Now
ce.Offset(, 5).Value = UName
ce.Offset(, 6).Font.ColorIndex = 0
ce.Offset(, 6).Font.Bold = False
ce.Offset(, 6).Value = "Completed"
'End Completed code
Workbooks(shname).Activate
Workbooks(shname).Close SaveChanges:=True
End If 'End #5
End If 'END #4
'End open file code
End If 'END #3
Next ce
End Sub

Function WorkbookIsOpen(wbname) As Boolean

Dim wb As Workbook
On Error Resume Next
Set wb = Workbooks(wbname)
If Err = 0 Then
WorkbookIsOpen = True
Else
WorkbookIsOpen = False
End If
End Function
 

Excel Facts

Excel Joke
Why can't spreadsheets drive cars? They crash too often!

Adrae

Active Member
Joined
Feb 19, 2002
Messages
306
BUMP...I could really use any idea at all....it doesn't even have to be a complete solution.

If you have a theory on what might work....please share it.

Thanks!
 

Watch MrExcel Video

Forum statistics

Threads
1,129,806
Messages
5,638,475
Members
417,026
Latest member
UDK

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top