Maybe it's one of those Canadian fonts where nothing looks funny????

<gd&r

Gord Dibben wrote:

How come I don't see any funny characters in Jenny's post?

I miss out on everything<g

All I see are regular characters in her post and little hollow boxes when I add
CHAR(9)'s in a formula.

Gord

On Sun, 02 Mar 2008 19:56:15 -0600, Dave Peterson
wrote:

First, if you look at your post, you'll see a bunch of funny characters in it.
I bet that they're caused by composing in MSWord, then copy|pasting to your
message.

This makes it more difficult to read and edit the code. You may want to use a
plain text editor (NotePad???) to make it easier for potential responders.

And maybe this untested, but compiled code is what you want:

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
Dim DestCell As Range

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
'get ready to paste into Sheet1 at the bottom of column A
With WkbkBRng.Parent
Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
myCell.EntireRow.Copy _
Destination:=DestCell
End With
End If
Next myCell

Application.ScreenUpdating = 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

I did remove the .close (and save). I wasn't sure if you really wanted that.

Jenny B. wrote:

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

--

Dave Peterson