Hello,
I am having trouble figuring out how to fix this code and am hoping someone here can help me out. I have the code below to compare sh1 to sh2. The code works fine if my sheet has single rows that meet the criteria. If there is multiple rows that meet the criteria, it will skip over them. I'm not getting any kind of error. The code runs all the way through. It just skips the rows with multiple criteria. Below is the code and parts of each spreadsheet to look at. As you can see from the example below, the notes in red transfer from sh2 to sh1 just fine except for the rows that have the same date more than once in column A. It should insert a row after the last row of that date also and insert the note from sh2. So it should insert a line and copy the note from sh2 after the second 3/28/14 on sh1 and do the same thing after the third 5/30/14 on sh1. I can also share the spreadsheet with the code if that would be more helpful. Any help would be much appreciated.
Here is part of sh1:
I am having trouble figuring out how to fix this code and am hoping someone here can help me out. I have the code below to compare sh1 to sh2. The code works fine if my sheet has single rows that meet the criteria. If there is multiple rows that meet the criteria, it will skip over them. I'm not getting any kind of error. The code runs all the way through. It just skips the rows with multiple criteria. Below is the code and parts of each spreadsheet to look at. As you can see from the example below, the notes in red transfer from sh2 to sh1 just fine except for the rows that have the same date more than once in column A. It should insert a row after the last row of that date also and insert the note from sh2. So it should insert a line and copy the note from sh2 after the second 3/28/14 on sh1 and do the same thing after the third 5/30/14 on sh1. I can also share the spreadsheet with the code if that would be more helpful. Any help would be much appreciated.
Code:
Dim sh1 As Worksheet, sh2 As Worksheet, lr As Long, rng As Range, c As Range, fLoc As RangeDim fAdr As String
Set sh1 = Sheets("Back Orders")
Set sh2 = Sheets("BO Save")
lr = sh1.Cells(Rows.Count, 5).End(xlUp).Row
Set rng = sh1.Range("E7:E" & lr)
For Each c In rng
Set fLoc = sh2.Range("E:E").Find(c.Value, , xlValues)
If Not fLoc Is Nothing Then
fAdr = fLoc.Address
Do
If Trim(c.Offset(0, -4).Value) = Trim(fLoc.Offset(0, -4).Value) Then
If fLoc.Offset(1, 0) = "" And fLoc.Offset(1, -4) <> "" Then
c.Offset(1, 0).EntireRow.Insert
fLoc.Offset(1, -4).Copy c.Offset(1, -4)
c.Offset(1, -4).Columns("A:J").Merge
End If
Exit Do
End If
fLoc = sh2.Range("E:E").FindNext(fLoc)
Loop While fAdr <> fLoc.Address
End If
Next
Here is part of sh1:
Conf. Date | Entr. Dt | Item number | Item Name | CO Number | Customer # | Rem Qty | Customer Name | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
3/28/14 | 3/24/14 | 36A90224 | MF 500 SS 90-D VITON NDL VALVE | 0001457521 | T00103480 | 50 | SAAB TRADING | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
3/28/14 | 3/24/14 | 36A00222 | MF 250 SS NEEDLE VALVE | 0001457521 | T00103480 | 25 | SAAB TRADING | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
4/21/14 | 4/9/14 | 11600061 | 1.5"SET OF SOFT CONE PKG | 0001459420 | 71803 | 630 | LUFKIN MIDDLE EAST - FREE ZONE | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Credit Hold | |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
5/22/14 | 5/20/14 | 29A14269 | 3"8V PCSB W/1.5"COMP"G"CONE,HS | 0001462494 | 71803 | 4 | LUFKIN MIDDLE EAST - FREE ZONE | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Credit Hold | |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
5/29/14 | 5/23/14 | 21050116 | 1.12"-1.5"T302 ROD ROT W/ BC26 | 0001463802 | 71803 | 25 | LUFKIN MIDDLE EAST - FREE ZONE | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Credit Hold | |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
5/30/14 | 3/27/14 | 12049401 | 5/8"-1"SET OF BUNA-N RAMS(2) | 0001457885 | T00103577 | 36 | NATIONAL DRILLING SERVICES CO, LLC | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
5/30/14 | 3/27/14 | 12049402 | 1.12" SET OF BUNA-N RAMS (2) | 0001457885 | T00103577 | 32 | NATIONAL DRILLING SERVICES CO, LLC | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
5/30/14 | 3/27/14 | 12049403 | 1.25" SET OF BUNA-N RAMS (2) | 0001457885 | T00103577 | 12 | NATIONAL DRILLING SERVICES CO, LLC | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
6/2/14 | 5/22/14 | 21203006 | 1.5"FIGURE 3 HINGE CLAMP | 0001463603 | 71803 | 150 | LUFKIN MIDDLE EAST - FREE ZONE | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Credit Hold and here is part of sh2:
|