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

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

Hello Dave,

Thank you for the tip on my post. I was composing this in Outlook and
thought the offending party adding the symbols was after I pasted it in the
Disscussion Group Window - my error.

What you wrote works great, but is there any way to have it paste just the
values vs. the exact formatting on all the cells? I want the whole line of
data like now, but I'm just looking to paste over just the values since the
one sheet has different formatting then the other.

Thank you very much and appreciate your help - Jenny B.

"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 couldn€„¢t get this one to work and was wondering if you could
help me since you originally helped this user set-up this application.

I€„¢m 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. That€„¢s the portion I€„¢m looking to
expand on €€œ I really don€„¢t 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 I€„¢d need code for and the only part
I€„¢d like to modify. I€„¢d like it to do the same thing meaning find next empty
row down in €œD€Â� and again write the value, but I€„¢m 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 I€„¢m looking for. I€„¢ve also added notes
to the portion I€„¢m 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 _ €˜ don€„¢t 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

myCell.EntireRow.Copy _
Destination:=DestCell

becomes

myCell.EntireRow.Copy
destcell.pastespecial paste:=xlpastevalues



Jenny B. wrote:

Hello Dave,

Thank you for the tip on my post. I was composing this in Outlook and
thought the offending party adding the symbols was after I pasted it in the
Disscussion Group Window - my error.

What you wrote works great, but is there any way to have it paste just the
values vs. the exact formatting on all the cells? I want the whole line of
data like now, but I'm just looking to paste over just the values since the
one sheet has different formatting then the other.

Thank you very much and appreciate your help - Jenny B.

"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 couldn€„¢t get this one to work and was wondering if you could
help me since you originally helped this user set-up this application.

I€„¢m 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. That€„¢s the portion I€„¢m looking to
expand on €€œ I really don€„¢t 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 I€„¢d need code for and the only part
I€„¢d like to modify. I€„¢d like it to do the same thing meaning find next empty
row down in €œD€Â� and again write the value, but I€„¢m 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 I€„¢m looking for. I€„¢ve also added notes
to the portion I€„¢m 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 _ €˜ don€„¢t 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


--

Dave Peterson

Thank you very much - works great!

"Dave Peterson" wrote:

myCell.EntireRow.Copy _
Destination:=DestCell

becomes

myCell.EntireRow.Copy
destcell.pastespecial paste:=xlpastevalues



Jenny B. wrote:

Hello Dave,

Thank you for the tip on my post. I was composing this in Outlook and
thought the offending party adding the symbols was after I pasted it in the
Disscussion Group Window - my error.

What you wrote works great, but is there any way to have it paste just the
values vs. the exact formatting on all the cells? I want the whole line of
data like now, but I'm just looking to paste over just the values since the
one sheet has different formatting then the other.

Thank you very much and appreciate your help - Jenny B.

"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 couldn€„¢t get this one to work and was wondering if you could
help me since you originally helped this user set-up this application.

I€„¢m 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. That€„¢s the portion I€„¢m looking to
expand on €€œ I really don€„¢t 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 I€„¢d need code for and the only part
I€„¢d like to modify. I€„¢d like it to do the same thing meaning find next empty
row down in €ŀœD€ÂÂ� and again write the value, but I€„¢m 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 I€„¢m looking for. I€„¢ve also added notes
to the portion I€„¢m 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 _ €˜ don€„¢t 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


--

Dave Peterson

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

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