If product already exists continued

[winnie123]

Apologies for the duplicate posting but I realised I replied to a question I
asked on the 9th May so not sure if it will get picked up.

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

 

[joel]

I guess we are working a few different problems today, You need to check
column E for all values that match the product by using Find and Findnext
method. Then stop when column H also matches. I use c.offset(0,3) where c
is in column e and column H is 3 columns over to check the QTY. See code
below.

I added the declaration in the code below
Dim firstAddr as string

When using findNext it will go into an endless loop unless you compare again
the first cell that is found.

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
Dim firstAddr 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
Found = False
Set c = .Columns("E").Find(what:=Product, _
LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
firstAddr = c.Address
Do
If c.Offset(0, 3) = Qty Then
Found = True
Exit Do
End If
Set c = .Columns("E").FindNext(after:=c)
Loop While Not c Is Nothing And c.Address <> firstAddr

End If
End With
If Found = False 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

 

[winnie123]

Thanks Joel

Definately no cigar for me today. Yes the addition of the QTY gave me the
same 2 issues with the same 2 modules I had before.

So just to clarify if i wanted(more likely I missed) to add a NEW criteria I
would set the new value (=WS, Range,Value)

Then I would change

Fom
If c.Offset(0, 3) = Qty Then

To
If c.Offset(0, 3) = Qty And c.Offset(0, 5) = New Then

I think I have got it.

Thanks ever so much , truly appreciate all the help.

Best regards