If Product already exist then overwrite that row

W

winnie123

Hi,

Bit shamed that I have to keep comming back day after day but I have hit
another problem.

The workbook I have created will allow user to set up records for customer
pricing.
The code below is the module that will check if the file already exist and
if so it will add the new record to that file and If it does not exist it
will go to a nother module to create a new workbook.

Sub Copy_To_Another_Workbook()
Dim SourceRange As Range
Dim DestRange As Range
Dim DestWB As Workbook
Dim DestSh As Worksheet
Dim Lr As Long
Dim wsNew As Worksheet
Dim bk As Workbook
Dim bSave As Boolean
Dim myFile As String


With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Customer = Worksheets("CurrentRecord").Range("F2").Value
With Worksheets("CustomerLogSheet").Columns("A")
Set C = .Columns("A").Find(what:=Customer, _
LookIn:=xlValues, lookat:=xlWhole)

End With

If C Is Nothing Then
Application.Run "Copy_To_Workbooks4"
Else
myFile = C.Offset(0, 1).Value
Set DestWB = Workbooks.Open(myFile)
Sheets(1).Unprotect Password:="mypsswrd"


'Change the Source Sheet and range
Set SourceRange = ThisWorkbook.Sheets("CurrentRecord").Range("A2:G2")
'Change the sheet name of the database workbook
Set DestSh = DestWB.Sheets(1)


Lr = LastRow(DestSh)
Set DestRange = DestSh.Range("A" & Lr + 1)

'We make DestRange the same size as SourceRange and use the Value
'property to give DestRange the same values
With SourceRange
Set DestRange = DestRange.Resize(.Rows.Count, .Columns.Count)
End With
DestRange.Value = SourceRange.Value

Sheets(1).Protect Password:="mypsswrd"
DestWB.Close savechanges:=True

With Application
.ScreenUpdating = True
.EnableEvents = True
End With

Sheets("CurrentRecord").Select
Sheets("CurrentRecord").Unprotect Password:="mypsswrd"
Range("A2:G2").Clear
Sheets("CurrentRecord").Protect Password:="mypsswrd"

End If
End Sub


The problem I am having is that if the product already eixts for that
customer I want it to overwrite that row with the new data. I have tried the
code below but, yes you have guessed it doesn't work. Just copies to the last
row.

Sub Copy_To_Another_Workbook()
Dim SourceRange As Range
Dim DestRange As Range
Dim DestWB As Workbook
Dim DestSh As Worksheet
Dim Lr As Long
Dim wsNew As Worksheet
Dim bk As Workbook
Dim bSave As Boolean
Dim myFile As String


With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Customer = Worksheets("CurrentRecord").Range("F2").Value
With Worksheets("CustomerLogSheet").Columns("A")
Set C = .Columns("A").Find(what:=Customer, _
LookIn:=xlValues, lookat:=xlWhole)

End With

If C Is Nothing Then
Application.Run "Copy_To_Workbooks4"
Else
Product = Worksheets("CurrentRecord").Range("E2").Value
myFile = C.Offset(0, 1).Value
Set DestWB = Workbooks.Open(myFile)
Sheets(1).Unprotect Password:="mypsswrd"

'Change the Source Sheet and range
Set SourceRange = ThisWorkbook.Sheets("CurrentRecord").Range("A2:G2")
'Change the sheet name of the database workbook
Set DestSh = DestWB.Sheets(1)


With DestSh.Columns("E")

Set C = .Columns("E").Find(what:=Product, _
LookIn:=xlValues, lookat:=xlWhole)
If C Is Nothing Then


Lr = LastRow(DestSh)
Set DestRange = DestSh.Range("A" & Lr + 1)

'We make DestRange the same size as SourceRange and use the Value
'property to give DestRange the same values
With SourceRange
Set DestRange = DestRange.Resize(.Rows.Count, .Columns.Count)
End With
DestRange.Value = SourceRange.Value

Sheets(1).Protect Password:="danrob1968"
DestWB.Close savechanges:=True

With Application
.ScreenUpdating = True
.EnableEvents = True
End With

Sheets("CurrentRecord").Select
Sheets("CurrentRecord").Unprotect Password:="danrob1968"
Range("A2:G2").Clear
Sheets("CurrentRecord").Protect Password:="danrob1968"

Else
If C Is Found Then
Set firstAddress = C.Address
C.Row = C.Address
Set DestRange = DestSh.Range("A" & C.Row)
With SourceRange
Set DestRange = DestRange.Resize(.Rows.Count, .Columns.Count)
End With
DestRange.Value = SourceRange.Value
Sheets(1).Protect Password:="mypsswrd"
DestWB.Close savechanges:=True

With Application
.ScreenUpdating = True
.EnableEvents = True
End With

Sheets("CurrentRecord").Select
Sheets("CurrentRecord").Unprotect Password:="mypsswrd"
Range("A2:G2").Clear
Sheets("CurrentRecord").Protect Password:="mypsswrd"
End If
End With
End If
End Sub


can you help me AGAIN.

Thanks
Winnie
 
P

Per Jessen

Hi again Winnie,

In your code C will either be Nothing (No match) or have a range object
refering to the cell fund. I just commented out the lines to remove.

---CUT---
Else
'If C Is Found Then
' Set firstAddress = C.Address
' C.Row = C.Address
Set DestRange = DestSh.Range("A" & C.Row)
With SourceRange
Set DestRange = DestRange.Resize(.Rows.Count, .Columns.Count)
---CUT---

BTW: I see you are using two different passwords, which I guess isn't
intented. If that is right, Your code can be reduced to the below:

Sub Copy_To_Another_Workbook()
Dim SourceRange As Range
Dim DestRange As Range
Dim DestWB As Workbook
Dim DestSh As Worksheet
Dim Lr As Long
Dim wsNew As Worksheet
Dim myFile As String
Const MyPassword As String = "danrob1968"

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Customer = Worksheets("CurrentRecord").Range("F2").Value
With Worksheets("CustomerLogSheet").Columns("A")
Set C = .Columns("A").Find(what:=Customer, _
LookIn:=xlValues, lookat:=xlWhole)
End With

If C Is Nothing Then
Application.Run "Copy_To_Workbooks4"
Else
Product = Worksheets("CurrentRecord").Range("E2").Value
myFile = C.Offset(0, 1).Value
Set DestWB = Workbooks.Open(myFile)
'Change the sheet name of the database workbook
Set DestSh = DestWB.Sheets(1)
DestSh.Unprotect Password:=MyPassword

'Change the Source Sheet and range
Set SourceRange = ThisWorkbook.Sheets("CurrentRecord").Range("A2:G2")


With DestSh '.Columns("E")
Set C = .Columns("E").Find(what:=Product, _
LookIn:=xlValues, lookat:=xlWhole)
End With
If C Is Nothing Then
Lr = LastRow(DestSh)
Set DestRange = DestSh.Range("A" & Lr + 1)
Else
Set DestRange = DestSh.Range("A" & C.Row)
End If
With SourceRange
Set DestRange = DestRange.Resize(1, 7) '(.Rows.Count,
..Columns.Count)
End With
DestRange.Value = SourceRange.Value
DestSh.Protect Password:=MyPassword
DestWB.Close savechanges:=True

With Sheets("CurrentRecord")
.Unprotect Password:=MyPassword
.Range("A2:G2").Clear
.Protect Password:=MyPassword
End With
End If
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

Best regards,
Per
 
W

winnie123

Your a star Per,

Can not believe I spent all day on this and the changes you made works first
time.

I will keep plodding along and hopefully one day may be able to do it all my
myself.

Thanks for the improvements too.

Winnie
 
W

winnie123

Hi,

If I wanted to include another criteria how would I implement.

I have now had to include a qty for possible price breaks. With the help of
Joel today I mangaed to sort out my first module but can not get the module
which copies the record to the destination file. Per helped me with this
module

I would like to add

With DestSh
Set C = .Columns("H").Find(what:=Qty, _
LookIn:=xlValues, lookat:=xlWhole)

but it just not working for me. I have tried different ways but to no avail.

Code below

Sub Copy_To_Another_Workbook1()
Dim SourceRange As Range
Dim DestRange As Range
Dim DestWB As Workbook
Dim DestSh As Worksheet
Dim Lr As Long
Dim wsNew As Worksheet
Dim myFile As String
Const MyPassword As String = "mypsswrd"

With Application
..ScreenUpdating = False
..EnableEvents = False
End With

If Worksheets("CurrentRecord").Range("F2").Value = 0 Then
Exit Sub
End If

Customer = Worksheets("CurrentRecord").Range("F2").Value
With Worksheets("CustomerLogSheet").Columns("A")
Set C = .Columns("A").Find(what:=Customer, _
LookIn:=xlValues, lookat:=xlWhole)
End With

If C Is Nothing Then
Application.Run "Copy_To_Workbooks4"
Else
Product = Worksheets("CurrentRecord").Range("E2").Value
Qty = Worksheets("CurrentRecord").Range("H2").Value
myFile = C.Offset(0, 1).Value
Set DestWB = Workbooks.Open(myFile)
'Change the sheet name of the database workbook
Set DestSh = DestWB.Sheets(1)
DestSh.Unprotect Password:=MyPassword

'Change the Source Sheet and range
Set SourceRange = ThisWorkbook.Sheets("CurrentRecord").Range("A2:H2")


With DestSh '.Columns("E")
Set C = .Columns("E") And .Columns("H").Find(what:=Product, _
LookIn:=xlValues, lookat:=xlWhole)
Set C = .Columns("H").Find(what:=Qty, _
LookIn:=xlValues, lookat:=xlWhole)
End With
If C Is Nothing Then
Lr = LastRow(DestSh)
Set DestRange = DestSh.Range("A" & Lr + 1)
Else
Set DestRange = DestSh.Range("A" & C.Row)
End If
With SourceRange
Set DestRange = DestRange.Resize(1, 8)
End With
DestRange.Value = SourceRange.Value
DestSh.Protect Password:=MyPassword
DestWB.Close savechanges:=True

With Sheets("CurrentRecord")
..Unprotect Password:=MyPassword
..Range("A2").EntireRow.Delete
..Protect Password:=MyPassword
End With
'End If
With Application
..ScreenUpdating = True
..EnableEvents = True
End With
End Sub

Thanks for any help or guidance you may have
 
P

Per Jessen

Hi Winnie

I think this what you need:

--Cut---

With DestSh '.Columns("E")
Set C = .Columns("E").Find(what:=Product, _
LookIn:=xlValues, lookat:=xlWhole)
Set FirstCell = C
If Not C Is Nothing Then
Do
If Range("H" & C.Row) = Qty Then
Set DestRange = DestSh.Range("A" & C.Row)
Exit Do
Else
Set C = .Columns("E").FindNext
End If
Loop Until C.Address = FirstCell.Address
End If
End With
If DestRange Is Nothing Then
Lr = LastRow(DestSh)
Set DestRange = DestSh.Range("A" & Lr + 1)
End If
With SourceRange
Set DestRange = DestRange.Resize(1, 8)
End With

---Cut---

Best regards,
Per
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

If product already exists continued 2
Need assistance with code, please 8
Copy to Next Blank Row 5
VBA code for pasting links -- modifying RDB code for summary workbook 11
Copy data from Closed Workbook 3
Code to produce consistent new Workbook name 4
Name Conflict using Ron De Bruin's RDB_Merge_Data_Browse 8
Loop 2

Top