Creating an Excel Database in Separate Workbook
 

Hi,

I'm trying to take data from a spreadsheet by copying it, and then open a
new spreadsheet (that is saved on the c:\ drive), find the last row of data
in the spreadsheet, paste the data from the original spreadsheet, and then
save and close the database sheet.

I know this would probably be more efficient with Access, but the users will
not have access to Access, so I need to use Excel.

Any help with coding would be greatly appreciated.

Thanks,

Brian

Creating an Excel Database in Separate Workbook
 

See this page
http://www.rondebruin.nl/copy1.htm

See the last example that use another workbook as database

--
Regards Ron de Bruin
http://www.rondebruin.nl


"Brian C" wrote in message ...
Hi,

I'm trying to take data from a spreadsheet by copying it, and then open a
new spreadsheet (that is saved on the c:\ drive), find the last row of data
in the spreadsheet, paste the data from the original spreadsheet, and then
save and close the database sheet.

I know this would probably be more efficient with Access, but the users will
not have access to Access, so I need to use Excel.

Any help with coding would be greatly appreciated.

Thanks,

Brian

Creating an Excel Database in Separate Workbook
 

"Ron de Bruin" wrote:

See this page
http://www.rondebruin.nl/copy1.htm

See the last example that use another workbook as database

--
Regards Ron de Bruin
http://www.rondebruin.nl


"Brian C" wrote in message ...
Hi,

I'm trying to take data from a spreadsheet by copying it, and then open a
new spreadsheet (that is saved on the c:\ drive), find the last row of data
in the spreadsheet, paste the data from the original spreadsheet, and then
save and close the database sheet.

I know this would probably be more efficient with Access, but the users will
not have access to Access, so I need to use Excel.

Any help with coding would be greatly appreciated.

Thanks,

Brian


Hi Ron,

Thanks for the response. I tried the code on your web page, but I still
can't get it to select the first empty row after the last row of data. For
some reason it keeps goint to row 21.

BTW I'm using Excel 2000.

Here's the code I wrote so far:

Sub SaveCustomerInformation()
'
' SaveCustomerInformation Macro
'
' Keyboard Shortcut: Ctrl+n
'
Dim source As Range
Dim destwb As Workbook
Sheets("Sheet3").Visible = True
Sheets("Sheet3").Select
Set source = Range("A2:cg2")
source.Select
Selection.Copy
Workbooks.Open Filename:="c:\datafile.xls"
Windows("datafile.xls").Activate
Range("a1").Select
Dim destrange As Range
Dim Lr As Long
Lr = Sheets("sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row
Set destrange = Range("A" & Lr)
destrange.Select
destrange.PasteSpecial xlPasteValues
ActiveWorkbook.Save
ActiveWorkbook.Close
Windows("Inputsheet.xls").Activate
ActiveSheet.Select
Sheets(9).Visible = xlVeryHidden
End Sub

Creating an Excel Database in Separate Workbook
 

You not use the code from the site

This Example will do the same as the first example on this webpage
Only the database sheet is in another workbook.
The macro will open the database workbook if it is not open (It use the function to check if the workbook is already open)
The data will be paste as values in the first worksheet of the file "c:\test.xls"


Sub copy_to_another_workbook()
Dim sourceRange As Range
Dim destrange As Range
Dim destWB As Workbook
Dim Lr As Long

Application.ScreenUpdating = False
If bIsBookOpen("test.xls") Then
Set destWB = Workbooks("test.xls")
Else
Set destWB = Workbooks.Open("c:\test.xls")
End If
Lr = LastRow(destWB.Worksheets("Sheet1")) + 1
Set sourceRange = ThisWorkbook.Worksheets("Sheet1").Range("A1:C10")
Set destrange = destWB.Worksheets("Sheet1").Range("A" & Lr)
sourceRange.Copy
destrange.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
destWB.Close True
Application.ScreenUpdating = True
End Sub


Copy this function together with the LastRow function in the module

Function bIsBookOpen(ByRef szBookName As String) As Boolean
' Rob Bovey
On Error Resume Next
bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing)
End Function

Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function





--
Regards Ron de Bruin
http://www.rondebruin.nl


"Brian C" wrote in message ...


"Ron de Bruin" wrote:

See this page
http://www.rondebruin.nl/copy1.htm

See the last example that use another workbook as database

--
Regards Ron de Bruin
http://www.rondebruin.nl


"Brian C" wrote in message ...
Hi,

I'm trying to take data from a spreadsheet by copying it, and then open a
new spreadsheet (that is saved on the c:\ drive), find the last row of data
in the spreadsheet, paste the data from the original spreadsheet, and then
save and close the database sheet.

I know this would probably be more efficient with Access, but the users will
not have access to Access, so I need to use Excel.

Any help with coding would be greatly appreciated.

Thanks,

Brian


Hi Ron,

Thanks for the response. I tried the code on your web page, but I still
can't get it to select the first empty row after the last row of data. For
some reason it keeps goint to row 21.

BTW I'm using Excel 2000.

Here's the code I wrote so far:

Sub SaveCustomerInformation()
'
' SaveCustomerInformation Macro
'
' Keyboard Shortcut: Ctrl+n
'
Dim source As Range
Dim destwb As Workbook
Sheets("Sheet3").Visible = True
Sheets("Sheet3").Select
Set source = Range("A2:cg2")
source.Select
Selection.Copy
Workbooks.Open Filename:="c:\datafile.xls"
Windows("datafile.xls").Activate
Range("a1").Select
Dim destrange As Range
Dim Lr As Long
Lr = Sheets("sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row
Set destrange = Range("A" & Lr)
destrange.Select
destrange.PasteSpecial xlPasteValues
ActiveWorkbook.Save
ActiveWorkbook.Close
Windows("Inputsheet.xls").Activate
ActiveSheet.Select
Sheets(9).Visible = xlVeryHidden
End Sub

Creating an Excel Database in Separate Workbook
 

"Ron de Bruin" wrote:

You not use the code from the site

This Example will do the same as the first example on this webpage
Only the database sheet is in another workbook.
The macro will open the database workbook if it is not open (It use the function to check if the workbook is already open)
The data will be paste as values in the first worksheet of the file "c:\test.xls"


Sub copy_to_another_workbook()
Dim sourceRange As Range
Dim destrange As Range
Dim destWB As Workbook
Dim Lr As Long

Application.ScreenUpdating = False
If bIsBookOpen("test.xls") Then
Set destWB = Workbooks("test.xls")
Else
Set destWB = Workbooks.Open("c:\test.xls")
End If
Lr = LastRow(destWB.Worksheets("Sheet1")) + 1
Set sourceRange = ThisWorkbook.Worksheets("Sheet1").Range("A1:C10")
Set destrange = destWB.Worksheets("Sheet1").Range("A" & Lr)
sourceRange.Copy
destrange.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
destWB.Close True
Application.ScreenUpdating = True
End Sub


Copy this function together with the LastRow function in the module

Function bIsBookOpen(ByRef szBookName As String) As Boolean
' Rob Bovey
On Error Resume Next
bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing)
End Function

Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function





--
Regards Ron de Bruin
http://www.rondebruin.nl


"Brian C" wrote in message ...


"Ron de Bruin" wrote:

See this page
http://www.rondebruin.nl/copy1.htm

See the last example that use another workbook as database

--
Regards Ron de Bruin
http://www.rondebruin.nl


"Brian C" wrote in message ...
Hi,

I'm trying to take data from a spreadsheet by copying it, and then open a
new spreadsheet (that is saved on the c:\ drive), find the last row of data
in the spreadsheet, paste the data from the original spreadsheet, and then
save and close the database sheet.

I know this would probably be more efficient with Access, but the users will
not have access to Access, so I need to use Excel.

Any help with coding would be greatly appreciated.

Thanks,

Brian


Hi Ron,

Thanks for the response. I tried the code on your web page, but I still
can't get it to select the first empty row after the last row of data. For
some reason it keeps goint to row 21.

BTW I'm using Excel 2000.

Here's the code I wrote so far:

Sub SaveCustomerInformation()
'
' SaveCustomerInformation Macro
'
' Keyboard Shortcut: Ctrl+n
'
Dim source As Range
Dim destwb As Workbook
Sheets("Sheet3").Visible = True
Sheets("Sheet3").Select
Set source = Range("A2:cg2")
source.Select
Selection.Copy
Workbooks.Open Filename:="c:\datafile.xls"
Windows("datafile.xls").Activate
Range("a1").Select
Dim destrange As Range
Dim Lr As Long
Lr = Sheets("sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row
Set destrange = Range("A" & Lr)
destrange.Select
destrange.PasteSpecial xlPasteValues
ActiveWorkbook.Save
ActiveWorkbook.Close
Windows("Inputsheet.xls").Activate
ActiveSheet.Select
Sheets(9).Visible = xlVeryHidden
End Sub


Ron,

Thank you very much, this worked great, but created another question. I
need a way to avoid entry of duplicate records in the Excel Database. i.e.
if the user saves the same record, I want to look at the database, and ask
them if they want to overwrite the existing data or create a new one.

Thanks again,

Brian

Creating an Excel Database in Separate Workbook
 

Hi Brian

Do you have one column that we can use to test for the duplicate


--
Regards Ron de Bruin
http://www.rondebruin.nl


"Brian C" wrote in message ...


"Ron de Bruin" wrote:

You not use the code from the site

This Example will do the same as the first example on this webpage
Only the database sheet is in another workbook.
The macro will open the database workbook if it is not open (It use the function to check if the workbook is already open)
The data will be paste as values in the first worksheet of the file "c:\test.xls"


Sub copy_to_another_workbook()
Dim sourceRange As Range
Dim destrange As Range
Dim destWB As Workbook
Dim Lr As Long

Application.ScreenUpdating = False
If bIsBookOpen("test.xls") Then
Set destWB = Workbooks("test.xls")
Else
Set destWB = Workbooks.Open("c:\test.xls")
End If
Lr = LastRow(destWB.Worksheets("Sheet1")) + 1
Set sourceRange = ThisWorkbook.Worksheets("Sheet1").Range("A1:C10")
Set destrange = destWB.Worksheets("Sheet1").Range("A" & Lr)
sourceRange.Copy
destrange.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
destWB.Close True
Application.ScreenUpdating = True
End Sub


Copy this function together with the LastRow function in the module

Function bIsBookOpen(ByRef szBookName As String) As Boolean
' Rob Bovey
On Error Resume Next
bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing)
End Function

Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function





--
Regards Ron de Bruin
http://www.rondebruin.nl


"Brian C" wrote in message ...


"Ron de Bruin" wrote:

See this page
http://www.rondebruin.nl/copy1.htm

See the last example that use another workbook as database

--
Regards Ron de Bruin
http://www.rondebruin.nl


"Brian C" wrote in message ...
Hi,

I'm trying to take data from a spreadsheet by copying it, and then open a
new spreadsheet (that is saved on the c:\ drive), find the last row of data
in the spreadsheet, paste the data from the original spreadsheet, and then
save and close the database sheet.

I know this would probably be more efficient with Access, but the users will
not have access to Access, so I need to use Excel.

Any help with coding would be greatly appreciated.

Thanks,

Brian


Hi Ron,

Thanks for the response. I tried the code on your web page, but I still
can't get it to select the first empty row after the last row of data. For
some reason it keeps goint to row 21.

BTW I'm using Excel 2000.

Here's the code I wrote so far:

Sub SaveCustomerInformation()
'
' SaveCustomerInformation Macro
'
' Keyboard Shortcut: Ctrl+n
'
Dim source As Range
Dim destwb As Workbook
Sheets("Sheet3").Visible = True
Sheets("Sheet3").Select
Set source = Range("A2:cg2")
source.Select
Selection.Copy
Workbooks.Open Filename:="c:\datafile.xls"
Windows("datafile.xls").Activate
Range("a1").Select
Dim destrange As Range
Dim Lr As Long
Lr = Sheets("sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row
Set destrange = Range("A" & Lr)
destrange.Select
destrange.PasteSpecial xlPasteValues
ActiveWorkbook.Save
ActiveWorkbook.Close
Windows("Inputsheet.xls").Activate
ActiveSheet.Select
Sheets(9).Visible = xlVeryHidden
End Sub


Ron,

Thank you very much, this worked great, but created another question. I
need a way to avoid entry of duplicate records in the Excel Database. i.e.
if the user saves the same record, I want to look at the database, and ask
them if they want to overwrite the existing data or create a new one.

Thanks again,

Brian

Creating an Excel Database in Separate Workbook
 

Hi Ron,

In the Data Worksheet, the first column ("A") could be used to determine if
the data already exists.

Thanks,

Brian

Creating an Excel Database in Separate Workbook
 

17:42 here
After dinner I make a example for you

--
Regards Ron de Bruin
http://www.rondebruin.nl


"Brian C" wrote in message ...
Hi Ron,

In the Data Worksheet, the first column ("A") could be used to determine if
the data already exists.

Thanks,

Brian

Creating an Excel Database in Separate Workbook
 

Ron,

Enjoy your meal. Thanks alot for all your help.

Brian

Creating an Excel Database in Separate Workbook
 

Hi Brian

Try this one that copy A1:H1 to the Database workbook

Sub copy_to_another_workbook_test()
Dim sourceRange As Range
Dim destrange As Range
Dim destWB As Workbook
Dim Lr As Long
Dim rng As Range
Dim answer

Application.ScreenUpdating = False
If bIsBookOpen("test.xls") Then
Set destWB = Workbooks("test.xls")
Else
Set destWB = Workbooks.Open("c:\test.xls")
End If

Lr = LastRow(destWB.Worksheets("Sheet1")) + 1
Set sourceRange = ThisWorkbook.Worksheets("Sheet1").Range("A1:H1")
Set destrange = destWB.Worksheets("Sheet1").Range("A" & Lr)


With destWB.Sheets("Sheet1").Range("A:A")
Set rng = .Find(What:=sourceRange.Cells(1).Value, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)


If Not rng Is Nothing Then
answer = MsgBox("Do you want to overwrite the existing data ", vbYesNo, "something")
If answer = vbYes Then
sourceRange.Copy
rng.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
destWB.Close True
Else
sourceRange.Copy
destrange.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
destWB.Close True
End If

Else
sourceRange.Copy
destrange.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
destWB.Close True
End If
End With

Application.ScreenUpdating = True

End Sub


--
Regards Ron de Bruin
http://www.rondebruin.nl


"Brian C" wrote in message ...


Ron,

Enjoy your meal. Thanks alot for all your help.

Brian

Creating an Excel Database in Separate Workbook
 

Hi Ron,

I realize it's about 8:00pm. I tried the code below, and got a Syntax error
on the Set rng= ... command.

With destWB.Sheets("Sheet 3").Range("A:7")
Set rng = .Find(What:=sourceRange.Cells(1).Value,_
After:=.Cells(.Cells.Count), _


Thanks,

Brian

"Ron de Bruin" wrote:

Hi Brian

Try this one that copy A1:H1 to the Database workbook

Sub copy_to_another_workbook_test()
Dim sourceRange As Range
Dim destrange As Range
Dim destWB As Workbook
Dim Lr As Long
Dim rng As Range
Dim answer

Application.ScreenUpdating = False
If bIsBookOpen("test.xls") Then
Set destWB = Workbooks("test.xls")
Else
Set destWB = Workbooks.Open("c:\test.xls")
End If

Lr = LastRow(destWB.Worksheets("Sheet1")) + 1
Set sourceRange = ThisWorkbook.Worksheets("Sheet1").Range("A1:H1")
Set destrange = destWB.Worksheets("Sheet1").Range("A" & Lr)


With destWB.Sheets("Sheet1").Range("A:A")
Set rng = .Find(What:=sourceRange.Cells(1).Value, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)


If Not rng Is Nothing Then
answer = MsgBox("Do you want to overwrite the existing data ", vbYesNo, "something")
If answer = vbYes Then
sourceRange.Copy
rng.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
destWB.Close True
Else
sourceRange.Copy
destrange.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
destWB.Close True
End If

Else
sourceRange.Copy
destrange.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
destWB.Close True
End If
End With

Application.ScreenUpdating = True

End Sub


--
Regards Ron de Bruin
http://www.rondebruin.nl


"Brian C" wrote in message ...


Ron,

Enjoy your meal. Thanks alot for all your help.

Brian

Creating an Excel Database in Separate Workbook
 

Hi Brian

The range is not valid in your code and I don't know if the sheet name is correct with the space between the t and 3

Sheets("Sheet 3").Range("A:7")

--
Regards Ron de Bruin
http://www.rondebruin.nl


"Brian C" wrote in message ...
Hi Ron,

I realize it's about 8:00pm. I tried the code below, and got a Syntax error
on the Set rng= ... command.

With destWB.Sheets("Sheet 3").Range("A:7")
Set rng = .Find(What:=sourceRange.Cells(1).Value,_
After:=.Cells(.Cells.Count), _


Thanks,

Brian

"Ron de Bruin" wrote:

Hi Brian

Try this one that copy A1:H1 to the Database workbook

Sub copy_to_another_workbook_test()
Dim sourceRange As Range
Dim destrange As Range
Dim destWB As Workbook
Dim Lr As Long
Dim rng As Range
Dim answer

Application.ScreenUpdating = False
If bIsBookOpen("test.xls") Then
Set destWB = Workbooks("test.xls")
Else
Set destWB = Workbooks.Open("c:\test.xls")
End If

Lr = LastRow(destWB.Worksheets("Sheet1")) + 1
Set sourceRange = ThisWorkbook.Worksheets("Sheet1").Range("A1:H1")
Set destrange = destWB.Worksheets("Sheet1").Range("A" & Lr)


With destWB.Sheets("Sheet1").Range("A:A")
Set rng = .Find(What:=sourceRange.Cells(1).Value, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)


If Not rng Is Nothing Then
answer = MsgBox("Do you want to overwrite the existing data ", vbYesNo, "something")
If answer = vbYes Then
sourceRange.Copy
rng.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
destWB.Close True
Else
sourceRange.Copy
destrange.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
destWB.Close True
End If

Else
sourceRange.Copy
destrange.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
destWB.Close True
End If
End With

Application.ScreenUpdating = True

End Sub


--
Regards Ron de Bruin
http://www.rondebruin.nl


"Brian C" wrote in message ...


Ron,

Enjoy your meal. Thanks alot for all your help.

Brian

Creating an Excel Database in Separate Workbook
 

Hi Ron,

I got it to go through the code, but it just adds the next record on. I
realized the data I'm looking to compare is in Column 4, not Column 1, so I
changed the lookup, but it still doesn't do the comparison and pop up the
message box.

Here's the entire code, let me know if you can see the problem.

Thanks,

Brian

Sub copy_to_another_workbook_test()
Dim sourceRange As Range
Dim destrange As Range
Dim destWB As Workbook
Dim Lr As Long
Dim rng As Range
Dim answer

Application.ScreenUpdating = False
If bIsBookOpen("CustomerData.xls") Then
Set destWB = Workbooks("CustomerData.xls")
Else
Set destWB = Workbooks.Open("c:\CustomerData.xls")
End If

Lr = LastRow(destWB.Worksheets("Sheet1")) + 1
Set sourceRange = ThisWorkbook.Worksheets("Sheet3").Range("A2:cg2")
Set destrange = destWB.Worksheets("Sheet1").Range("A" & Lr)


With destWB.Sheets("Sheet1").Range("A:A")
Set rng = .Find(What:=sourceRange.Cells(4).Value, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValue, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)


If Not rng Is Nothing Then
answer = MsgBox("Record Already Exists. Do you want to save over Customer
Record? ", vbYesNo, "something")
If answer = vbYes Then
sourceRange.Copy
rng.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
destWB.Close True
Else
sourceRange.Copy
destrange.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
destWB.Close True
End If

Else
sourceRange.Copy
destrange.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
destWB.Close True
End If
End With

Application.ScreenUpdating = True

End Sub



'Copy this function together with the LastRow function in the module

Function bIsBookOpen(ByRef szBookName As String) As Boolean
' Rob Bovey
On Error Resume Next
bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing)
End Function

Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function




"Ron de Bruin" wrote:

Hi Brian

The range is not valid in your code and I don't know if the sheet name is correct with the space between the t and 3

Sheets("Sheet 3").Range("A:7")

--
Regards Ron de Bruin
http://www.rondebruin.nl


"Brian C" wrote in message ...
Hi Ron,

I realize it's about 8:00pm. I tried the code below, and got a Syntax error
on the Set rng= ... command.

With destWB.Sheets("Sheet 3").Range("A:7")
Set rng = .Find(What:=sourceRange.Cells(1).Value,_
After:=.Cells(.Cells.Count), _


Thanks,

Brian

"Ron de Bruin" wrote:

Hi Brian

Try this one that copy A1:H1 to the Database workbook

Sub copy_to_another_workbook_test()
Dim sourceRange As Range
Dim destrange As Range
Dim destWB As Workbook
Dim Lr As Long
Dim rng As Range
Dim answer

Application.ScreenUpdating = False
If bIsBookOpen("test.xls") Then
Set destWB = Workbooks("test.xls")
Else
Set destWB = Workbooks.Open("c:\test.xls")
End If

Lr = LastRow(destWB.Worksheets("Sheet1")) + 1
Set sourceRange = ThisWorkbook.Worksheets("Sheet1").Range("A1:H1")
Set destrange = destWB.Worksheets("Sheet1").Range("A" & Lr)


With destWB.Sheets("Sheet1").Range("A:A")
Set rng = .Find(What:=sourceRange.Cells(1).Value, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)


If Not rng Is Nothing Then
answer = MsgBox("Do you want to overwrite the existing data ", vbYesNo, "something")
If answer = vbYes Then
sourceRange.Copy
rng.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
destWB.Close True
Else
sourceRange.Copy
destrange.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
destWB.Close True
End If

Else
sourceRange.Copy
destrange.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
destWB.Close True
End If
End With

Application.ScreenUpdating = True

End Sub


--
Regards Ron de Bruin
http://www.rondebruin.nl


"Brian C" wrote in message ...


Ron,

Enjoy your meal. Thanks alot for all your help.

Brian

Creating an Excel Database in Separate Workbook
 

Hi Brian

Change
With destWB.Sheets("Sheet1").Range("A:A")

To
With destWB.Sheets("Sheet1").Range("D:D")


--
Regards Ron de Bruin
http://www.rondebruin.nl


"Brian C" wrote in message ...
Hi Ron,

I got it to go through the code, but it just adds the next record on. I
realized the data I'm looking to compare is in Column 4, not Column 1, so I
changed the lookup, but it still doesn't do the comparison and pop up the
message box.

Here's the entire code, let me know if you can see the problem.

Thanks,

Brian

Sub copy_to_another_workbook_test()
Dim sourceRange As Range
Dim destrange As Range
Dim destWB As Workbook
Dim Lr As Long
Dim rng As Range
Dim answer

Application.ScreenUpdating = False
If bIsBookOpen("CustomerData.xls") Then
Set destWB = Workbooks("CustomerData.xls")
Else
Set destWB = Workbooks.Open("c:\CustomerData.xls")
End If

Lr = LastRow(destWB.Worksheets("Sheet1")) + 1
Set sourceRange = ThisWorkbook.Worksheets("Sheet3").Range("A2:cg2")
Set destrange = destWB.Worksheets("Sheet1").Range("A" & Lr)


With destWB.Sheets("Sheet1").Range("A:A")
Set rng = .Find(What:=sourceRange.Cells(4).Value, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValue, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)


If Not rng Is Nothing Then
answer = MsgBox("Record Already Exists. Do you want to save over Customer
Record? ", vbYesNo, "something")
If answer = vbYes Then
sourceRange.Copy
rng.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
destWB.Close True
Else
sourceRange.Copy
destrange.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
destWB.Close True
End If

Else
sourceRange.Copy
destrange.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
destWB.Close True
End If
End With

Application.ScreenUpdating = True

End Sub



'Copy this function together with the LastRow function in the module

Function bIsBookOpen(ByRef szBookName As String) As Boolean
' Rob Bovey
On Error Resume Next
bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing)
End Function

Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function




"Ron de Bruin" wrote:

Hi Brian

The range is not valid in your code and I don't know if the sheet name is correct with the space between the t and 3

Sheets("Sheet 3").Range("A:7")

--
Regards Ron de Bruin
http://www.rondebruin.nl


"Brian C" wrote in message ...
Hi Ron,

I realize it's about 8:00pm. I tried the code below, and got a Syntax error
on the Set rng= ... command.

With destWB.Sheets("Sheet 3").Range("A:7")
Set rng = .Find(What:=sourceRange.Cells(1).Value,_
After:=.Cells(.Cells.Count), _


Thanks,

Brian

"Ron de Bruin" wrote:

Hi Brian

Try this one that copy A1:H1 to the Database workbook

Sub copy_to_another_workbook_test()
Dim sourceRange As Range
Dim destrange As Range
Dim destWB As Workbook
Dim Lr As Long
Dim rng As Range
Dim answer

Application.ScreenUpdating = False
If bIsBookOpen("test.xls") Then
Set destWB = Workbooks("test.xls")
Else
Set destWB = Workbooks.Open("c:\test.xls")
End If

Lr = LastRow(destWB.Worksheets("Sheet1")) + 1
Set sourceRange = ThisWorkbook.Worksheets("Sheet1").Range("A1:H1")
Set destrange = destWB.Worksheets("Sheet1").Range("A" & Lr)


With destWB.Sheets("Sheet1").Range("A:A")
Set rng = .Find(What:=sourceRange.Cells(1).Value, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)


If Not rng Is Nothing Then
answer = MsgBox("Do you want to overwrite the existing data ", vbYesNo, "something")
If answer = vbYes Then
sourceRange.Copy
rng.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
destWB.Close True
Else
sourceRange.Copy
destrange.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
destWB.Close True
End If

Else
sourceRange.Copy
destrange.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
destWB.Close True
End If
End With

Application.ScreenUpdating = True

End Sub


--
Regards Ron de Bruin
http://www.rondebruin.nl


"Brian C" wrote in message ...


Ron,

Enjoy your meal. Thanks alot for all your help.

Brian

Creating an Excel Database in Separate Workbook
 

Hi Ron,

We're almost there. It finds the duplicate entry and does the past, but it
starts the paste in Column D instead of Column A. I know this is something
simple that I'm missing, but I can't figure out what.

Thank you very much!

Brian

"Ron de Bruin" wrote:

Hi Brian

Change
With destWB.Sheets("Sheet1").Range("A:A")

To
With destWB.Sheets("Sheet1").Range("D:D")


--
Regards Ron de Bruin
http://www.rondebruin.nl


"Brian C" wrote in message ...
Hi Ron,

I got it to go through the code, but it just adds the next record on. I
realized the data I'm looking to compare is in Column 4, not Column 1, so I
changed the lookup, but it still doesn't do the comparison and pop up the
message box.

Here's the entire code, let me know if you can see the problem.

Thanks,

Brian

Sub copy_to_another_workbook_test()
Dim sourceRange As Range
Dim destrange As Range
Dim destWB As Workbook
Dim Lr As Long
Dim rng As Range
Dim answer

Application.ScreenUpdating = False
If bIsBookOpen("CustomerData.xls") Then
Set destWB = Workbooks("CustomerData.xls")
Else
Set destWB = Workbooks.Open("c:\CustomerData.xls")
End If

Lr = LastRow(destWB.Worksheets("Sheet1")) + 1
Set sourceRange = ThisWorkbook.Worksheets("Sheet3").Range("A2:cg2")
Set destrange = destWB.Worksheets("Sheet1").Range("A" & Lr)


With destWB.Sheets("Sheet1").Range("A:A")
Set rng = .Find(What:=sourceRange.Cells(4).Value, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValue, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)


If Not rng Is Nothing Then
answer = MsgBox("Record Already Exists. Do you want to save over Customer
Record? ", vbYesNo, "something")
If answer = vbYes Then
sourceRange.Copy
rng.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
destWB.Close True
Else
sourceRange.Copy
destrange.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
destWB.Close True
End If

Else
sourceRange.Copy
destrange.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
destWB.Close True
End If
End With

Application.ScreenUpdating = True

End Sub



'Copy this function together with the LastRow function in the module

Function bIsBookOpen(ByRef szBookName As String) As Boolean
' Rob Bovey
On Error Resume Next
bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing)
End Function

Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function




"Ron de Bruin" wrote:

Hi Brian

The range is not valid in your code and I don't know if the sheet name is correct with the space between the t and 3

Sheets("Sheet 3").Range("A:7")

--
Regards Ron de Bruin
http://www.rondebruin.nl


"Brian C" wrote in message ...
Hi Ron,

I realize it's about 8:00pm. I tried the code below, and got a Syntax error
on the Set rng= ... command.

With destWB.Sheets("Sheet 3").Range("A:7")
Set rng = .Find(What:=sourceRange.Cells(1).Value,_
After:=.Cells(.Cells.Count), _


Thanks,

Brian

"Ron de Bruin" wrote:

Hi Brian

Try this one that copy A1:H1 to the Database workbook

Sub copy_to_another_workbook_test()
Dim sourceRange As Range
Dim destrange As Range
Dim destWB As Workbook
Dim Lr As Long
Dim rng As Range
Dim answer

Application.ScreenUpdating = False
If bIsBookOpen("test.xls") Then
Set destWB = Workbooks("test.xls")
Else
Set destWB = Workbooks.Open("c:\test.xls")
End If

Lr = LastRow(destWB.Worksheets("Sheet1")) + 1
Set sourceRange = ThisWorkbook.Worksheets("Sheet1").Range("A1:H1")
Set destrange = destWB.Worksheets("Sheet1").Range("A" & Lr)


With destWB.Sheets("Sheet1").Range("A:A")
Set rng = .Find(What:=sourceRange.Cells(1).Value, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)


If Not rng Is Nothing Then
answer = MsgBox("Do you want to overwrite the existing data ", vbYesNo, "something")
If answer = vbYes Then
sourceRange.Copy
rng.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
destWB.Close True
Else
sourceRange.Copy
destrange.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
destWB.Close True
End If

Else
sourceRange.Copy
destrange.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
destWB.Close True
End If
End With

Application.ScreenUpdating = True

End Sub


--
Regards Ron de Bruin
http://www.rondebruin.nl


"Brian C" wrote in message ...


Ron,

Enjoy your meal. Thanks alot for all your help.

Brian

Creating an Excel Database in Separate Workbook
 

We used rng to paste
Because we use column 4 now it paste there

Change it to this

If answer = vbYes Then
sourceRange.Copy
destWB.Sheets("Sheet1").Cells(rng.Row, 1).PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
destWB.Close True


Note: if you choose overwrite it only do this for the first one he find in the column


--
Regards Ron de Bruin
http://www.rondebruin.nl


"Brian C" wrote in message ...
Hi Ron,

We're almost there. It finds the duplicate entry and does the past, but it
starts the paste in Column D instead of Column A. I know this is something
simple that I'm missing, but I can't figure out what.

Thank you very much!

Brian

"Ron de Bruin" wrote:

Hi Brian

Change
With destWB.Sheets("Sheet1").Range("A:A")

To
With destWB.Sheets("Sheet1").Range("D:D")


--
Regards Ron de Bruin
http://www.rondebruin.nl


"Brian C" wrote in message ...
Hi Ron,

I got it to go through the code, but it just adds the next record on. I
realized the data I'm looking to compare is in Column 4, not Column 1, so I
changed the lookup, but it still doesn't do the comparison and pop up the
message box.

Here's the entire code, let me know if you can see the problem.

Thanks,

Brian

Sub copy_to_another_workbook_test()
Dim sourceRange As Range
Dim destrange As Range
Dim destWB As Workbook
Dim Lr As Long
Dim rng As Range
Dim answer

Application.ScreenUpdating = False
If bIsBookOpen("CustomerData.xls") Then
Set destWB = Workbooks("CustomerData.xls")
Else
Set destWB = Workbooks.Open("c:\CustomerData.xls")
End If

Lr = LastRow(destWB.Worksheets("Sheet1")) + 1
Set sourceRange = ThisWorkbook.Worksheets("Sheet3").Range("A2:cg2")
Set destrange = destWB.Worksheets("Sheet1").Range("A" & Lr)


With destWB.Sheets("Sheet1").Range("A:A")
Set rng = .Find(What:=sourceRange.Cells(4).Value, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValue, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)


If Not rng Is Nothing Then
answer = MsgBox("Record Already Exists. Do you want to save over Customer
Record? ", vbYesNo, "something")
If answer = vbYes Then
sourceRange.Copy
rng.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
destWB.Close True
Else
sourceRange.Copy
destrange.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
destWB.Close True
End If

Else
sourceRange.Copy
destrange.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
destWB.Close True
End If
End With

Application.ScreenUpdating = True

End Sub



'Copy this function together with the LastRow function in the module

Function bIsBookOpen(ByRef szBookName As String) As Boolean
' Rob Bovey
On Error Resume Next
bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing)
End Function

Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function




"Ron de Bruin" wrote:

Hi Brian

The range is not valid in your code and I don't know if the sheet name is correct with the space between the t and 3

Sheets("Sheet 3").Range("A:7")

--
Regards Ron de Bruin
http://www.rondebruin.nl


"Brian C" wrote in message ...
Hi Ron,

I realize it's about 8:00pm. I tried the code below, and got a Syntax error
on the Set rng= ... command.

With destWB.Sheets("Sheet 3").Range("A:7")
Set rng = .Find(What:=sourceRange.Cells(1).Value,_
After:=.Cells(.Cells.Count), _


Thanks,

Brian

"Ron de Bruin" wrote:

Hi Brian

Try this one that copy A1:H1 to the Database workbook

Sub copy_to_another_workbook_test()
Dim sourceRange As Range
Dim destrange As Range
Dim destWB As Workbook
Dim Lr As Long
Dim rng As Range
Dim answer

Application.ScreenUpdating = False
If bIsBookOpen("test.xls") Then
Set destWB = Workbooks("test.xls")
Else
Set destWB = Workbooks.Open("c:\test.xls")
End If

Lr = LastRow(destWB.Worksheets("Sheet1")) + 1
Set sourceRange = ThisWorkbook.Worksheets("Sheet1").Range("A1:H1")
Set destrange = destWB.Worksheets("Sheet1").Range("A" & Lr)


With destWB.Sheets("Sheet1").Range("A:A")
Set rng = .Find(What:=sourceRange.Cells(1).Value, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)


If Not rng Is Nothing Then
answer = MsgBox("Do you want to overwrite the existing data ", vbYesNo, "something")
If answer = vbYes Then
sourceRange.Copy
rng.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
destWB.Close True
Else
sourceRange.Copy
destrange.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
destWB.Close True
End If

Else
sourceRange.Copy
destrange.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
destWB.Close True
End If
End With

Application.ScreenUpdating = True

End Sub


--
Regards Ron de Bruin
http://www.rondebruin.nl


"Brian C" wrote in message ...


Ron,

Enjoy your meal. Thanks alot for all your help.

Brian

Creating an Excel Database in Separate Workbook
 

Ron,

You're a genius! Thanks for your help and your patience!

Brian

"Brian C" wrote:

Hi Ron,

We're almost there. It finds the duplicate entry and does the past, but it
starts the paste in Column D instead of Column A. I know this is something
simple that I'm missing, but I can't figure out what.

Thank you very much!

Brian

"Ron de Bruin" wrote:

Hi Brian

Change
With destWB.Sheets("Sheet1").Range("A:A")

To
With destWB.Sheets("Sheet1").Range("D:D")


--
Regards Ron de Bruin
http://www.rondebruin.nl


"Brian C" wrote in message ...
Hi Ron,

I got it to go through the code, but it just adds the next record on. I
realized the data I'm looking to compare is in Column 4, not Column 1, so I
changed the lookup, but it still doesn't do the comparison and pop up the
message box.

Here's the entire code, let me know if you can see the problem.

Thanks,

Brian

Sub copy_to_another_workbook_test()
Dim sourceRange As Range
Dim destrange As Range
Dim destWB As Workbook
Dim Lr As Long
Dim rng As Range
Dim answer

Application.ScreenUpdating = False
If bIsBookOpen("CustomerData.xls") Then
Set destWB = Workbooks("CustomerData.xls")
Else
Set destWB = Workbooks.Open("c:\CustomerData.xls")
End If

Lr = LastRow(destWB.Worksheets("Sheet1")) + 1
Set sourceRange = ThisWorkbook.Worksheets("Sheet3").Range("A2:cg2")
Set destrange = destWB.Worksheets("Sheet1").Range("A" & Lr)


With destWB.Sheets("Sheet1").Range("A:A")
Set rng = .Find(What:=sourceRange.Cells(4).Value, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValue, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)


If Not rng Is Nothing Then
answer = MsgBox("Record Already Exists. Do you want to save over Customer
Record? ", vbYesNo, "something")
If answer = vbYes Then
sourceRange.Copy
rng.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
destWB.Close True
Else
sourceRange.Copy
destrange.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
destWB.Close True
End If

Else
sourceRange.Copy
destrange.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
destWB.Close True
End If
End With

Application.ScreenUpdating = True

End Sub



'Copy this function together with the LastRow function in the module

Function bIsBookOpen(ByRef szBookName As String) As Boolean
' Rob Bovey
On Error Resume Next
bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing)
End Function

Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function




"Ron de Bruin" wrote:

Hi Brian

The range is not valid in your code and I don't know if the sheet name is correct with the space between the t and 3

Sheets("Sheet 3").Range("A:7")

--
Regards Ron de Bruin
http://www.rondebruin.nl


"Brian C" wrote in message ...
Hi Ron,

I realize it's about 8:00pm. I tried the code below, and got a Syntax error
on the Set rng= ... command.

With destWB.Sheets("Sheet 3").Range("A:7")
Set rng = .Find(What:=sourceRange.Cells(1).Value,_
After:=.Cells(.Cells.Count), _


Thanks,

Brian

"Ron de Bruin" wrote:

Hi Brian

Try this one that copy A1:H1 to the Database workbook

Sub copy_to_another_workbook_test()
Dim sourceRange As Range
Dim destrange As Range
Dim destWB As Workbook
Dim Lr As Long
Dim rng As Range
Dim answer

Application.ScreenUpdating = False
If bIsBookOpen("test.xls") Then
Set destWB = Workbooks("test.xls")
Else
Set destWB = Workbooks.Open("c:\test.xls")
End If

Lr = LastRow(destWB.Worksheets("Sheet1")) + 1
Set sourceRange = ThisWorkbook.Worksheets("Sheet1").Range("A1:H1")
Set destrange = destWB.Worksheets("Sheet1").Range("A" & Lr)


With destWB.Sheets("Sheet1").Range("A:A")
Set rng = .Find(What:=sourceRange.Cells(1).Value, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)


If Not rng Is Nothing Then
answer = MsgBox("Do you want to overwrite the existing data ", vbYesNo, "something")
If answer = vbYes Then
sourceRange.Copy
rng.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
destWB.Close True
Else
sourceRange.Copy
destrange.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
destWB.Close True
End If

Else
sourceRange.Copy
destrange.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
destWB.Close True
End If
End With

Application.ScreenUpdating = True

End Sub


--
Regards Ron de Bruin
http://www.rondebruin.nl


"Brian C" wrote in message ...


Ron,

Enjoy your meal. Thanks alot for all your help.

Brian

Creating an Excel Database in Separate Workbook
 

You are welcome

Have a nice day

--
Regards Ron de Bruin
http://www.rondebruin.nl


"Brian C" wrote in message ...
Ron,

You're a genius! Thanks for your help and your patience!

Brian

"Brian C" wrote:

Hi Ron,

We're almost there. It finds the duplicate entry and does the past, but it
starts the paste in Column D instead of Column A. I know this is something
simple that I'm missing, but I can't figure out what.

Thank you very much!

Brian

"Ron de Bruin" wrote:

Hi Brian

Change
With destWB.Sheets("Sheet1").Range("A:A")

To
With destWB.Sheets("Sheet1").Range("D:D")


--
Regards Ron de Bruin
http://www.rondebruin.nl


"Brian C" wrote in message ...
Hi Ron,

I got it to go through the code, but it just adds the next record on. I
realized the data I'm looking to compare is in Column 4, not Column 1, so I
changed the lookup, but it still doesn't do the comparison and pop up the
message box.

Here's the entire code, let me know if you can see the problem.

Thanks,

Brian

Sub copy_to_another_workbook_test()
Dim sourceRange As Range
Dim destrange As Range
Dim destWB As Workbook
Dim Lr As Long
Dim rng As Range
Dim answer

Application.ScreenUpdating = False
If bIsBookOpen("CustomerData.xls") Then
Set destWB = Workbooks("CustomerData.xls")
Else
Set destWB = Workbooks.Open("c:\CustomerData.xls")
End If

Lr = LastRow(destWB.Worksheets("Sheet1")) + 1
Set sourceRange = ThisWorkbook.Worksheets("Sheet3").Range("A2:cg2")
Set destrange = destWB.Worksheets("Sheet1").Range("A" & Lr)


With destWB.Sheets("Sheet1").Range("A:A")
Set rng = .Find(What:=sourceRange.Cells(4).Value, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValue, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)


If Not rng Is Nothing Then
answer = MsgBox("Record Already Exists. Do you want to save over Customer
Record? ", vbYesNo, "something")
If answer = vbYes Then
sourceRange.Copy
rng.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
destWB.Close True
Else
sourceRange.Copy
destrange.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
destWB.Close True
End If

Else
sourceRange.Copy
destrange.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
destWB.Close True
End If
End With

Application.ScreenUpdating = True

End Sub



'Copy this function together with the LastRow function in the module

Function bIsBookOpen(ByRef szBookName As String) As Boolean
' Rob Bovey
On Error Resume Next
bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing)
End Function

Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function




"Ron de Bruin" wrote:

Hi Brian

The range is not valid in your code and I don't know if the sheet name is correct with the space between the t and 3

Sheets("Sheet 3").Range("A:7")

--
Regards Ron de Bruin
http://www.rondebruin.nl


"Brian C" wrote in message ...
Hi Ron,

I realize it's about 8:00pm. I tried the code below, and got a Syntax error
on the Set rng= ... command.

With destWB.Sheets("Sheet 3").Range("A:7")
Set rng = .Find(What:=sourceRange.Cells(1).Value,_
After:=.Cells(.Cells.Count), _


Thanks,

Brian

"Ron de Bruin" wrote:

Hi Brian

Try this one that copy A1:H1 to the Database workbook

Sub copy_to_another_workbook_test()
Dim sourceRange As Range
Dim destrange As Range
Dim destWB As Workbook
Dim Lr As Long
Dim rng As Range
Dim answer

Application.ScreenUpdating = False
If bIsBookOpen("test.xls") Then
Set destWB = Workbooks("test.xls")
Else
Set destWB = Workbooks.Open("c:\test.xls")
End If

Lr = LastRow(destWB.Worksheets("Sheet1")) + 1
Set sourceRange = ThisWorkbook.Worksheets("Sheet1").Range("A1:H1")
Set destrange = destWB.Worksheets("Sheet1").Range("A" & Lr)


With destWB.Sheets("Sheet1").Range("A:A")
Set rng = .Find(What:=sourceRange.Cells(1).Value, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)


If Not rng Is Nothing Then
answer = MsgBox("Do you want to overwrite the existing data ", vbYesNo, "something")
If answer = vbYes Then
sourceRange.Copy
rng.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
destWB.Close True
Else
sourceRange.Copy
destrange.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
destWB.Close True
End If

Else
sourceRange.Copy
destrange.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
destWB.Close True
End If
End With

Application.ScreenUpdating = True

End Sub


--
Regards Ron de Bruin
http://www.rondebruin.nl


"Brian C" wrote in message ...


Ron,

Enjoy your meal. Thanks alot for all your help.

Brian