Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Programming > If Product already exist then overwrite that row
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 129
Default If Product already exist then overwrite that row
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




Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 1,533
Default If Product already exist then overwrite that row
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

"winnie123" skrev i meddelelsen
...
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





Reply With QuoteReply With Quote
  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 129
Default If Product already exist then overwrite that row
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

"Per Jessen" wrote:

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

"winnie123" skrev i meddelelsen
...
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






Reply With QuoteReply With Quote
  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 129
Default If Product already exist then overwrite that row
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





"winnie123" wrote:

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

"Per Jessen" wrote:

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

"winnie123" skrev i meddelelsen
...
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






Reply With QuoteReply With Quote
  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 1,533
Default If Product already exist then overwrite that row
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

"winnie123" skrev i meddelelsen
...
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





"winnie123" wrote:

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

"Per Jessen" wrote:

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

"winnie123" skrev i meddelelsen
...
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







Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Linear Mode Linear Mode

Posting Rules
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On

Similar Threads
Thread Thread Starter Forum Replies Last Post
Prevent PivotTable Overwrite Warning and Disallow Overwrite jonahviakeyboard Excel Programming 0 November 27th 07 05:08 PM
How to paste blanks only without overwrite exist cells in excel li Excel Discussion (Misc queries) 1 May 30th 07 12:43 PM
Vlookup code product and to copy commentary with photo of the product in vba [email protected] Excel Programming 0 October 2nd 06 03:54 AM
Copy Worksheet to a new Workbook creating if it doesn't exist and add more Worksheets if it does exist [email protected] Excel Programming 4 June 18th 06 06:08 PM
Command Line. How to tell to XL : If the xls file exist : Open it, if it does not exist : Create it. Tintin92 Excel Programming 3 March 11th 06 06:45 PM


All times are GMT +1. The time now is 07:20 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement