Hello Dave,

I try to look at past postings and modify existing macros before asking
questions, but I couldnt get this one to work and was wondering if you could
help me since you originally helped this user set-up this application.

Im looking to do something very similar to what this poster requested €“
only just one portion. It appears this macro is matching two values from the
main sheet and pasting to a second sheet and then also pasting over the value
for just one column for the unmatched. Thats the portion Im looking to
expand on €“ I really dont need any values brought over for the matched cells.

I have two workbooks Master Reports and Location Reports. Basically the €œIf
IsError(res) Then€� would be the portion Id need code for and the only part
Id like to modify. Id like it to do the same thing meaning find next empty
row down in €œD€� and again write the value, but Im looking to copy over the
entire unmatched row from Master Reports €œReport Log€� to that next down cell
starting with column €œD€� in Location Reports.

I tried to insert my sheets and columns in the code below and hopefully I
did in a way where you can tell what Im looking for. Ive also added notes
to the portion Im looking to modify and hopefully this will provide a bit
further detail.

Thanks in advance €“ Jenny B.


Option Explicit
Sub fyCompare()
Dim Msg As String
Dim myPath As String
Dim WkbkARng As Range
Dim WkbkBRng As Range
Dim WkbkB As Workbook
Dim myCell As Range
Dim res As Variant
Dim WkbkBName As String

Msg = "Unable to find"
myPath = "C:\Documents and Settings\Mine\Desktop\"
WkbkBName = "Location Reports.xls"

If WorkbookIsOpen(WkbkBName) = False Then
On Error Resume Next
Set WkbkB = Workbooks.Open(Filename:=myPath & WkbkBName)
If Err.Number < 0 Then
MsgBox Msg & myPath & WkbkBName, vbCritical, "Error"
Err.Clear
Exit Sub
End If
On Error GoTo 0
End If

Application.ScreenUpdating = False

Set WkbkARng = Workbooks("Master Reports.xls€�)
.Worksheets("Report Log€�).Range("A2:A2000€�)
Set WkbkBRng = WkbkB.Worksheets("Sheet1").Range("A2:A2000€�)

For Each myCell In WkbkARng.Cells
res = Application.Match(myCell.Value, WkbkBRng, 0)

If IsError(res) Then

With WkbkBRng.Parent
.Cells(.Rows.Count, "d€�).End(xlUp).Offset(1, 0).Value _
= myCell.Value
€˜looking to have this copy over the value from Master Reports to Location
Reports
€˜and copy the full row not just one cell
End With
Else
If WkbkBRng(res).Offset(0, 4).Value < "" Then
myCell.Offset(0, 1).Copy _ €˜ dont need this portion

End If
End If
Next myCell

wkbkb.ActiveWorkbook.Close savechanges:=True

End Sub

Private Function WorkbookIsOpen(wbName) As Boolean
Dim x As Workbook
On Error Resume Next
Set x = Workbooks(wbName)
If Err = 0 Then
WorkbookIsOpen = True
Else
WorkbookIsOpen = False
End If
On Error GoTo 0
End Function