Compare and Copy Code Trouble

T

THRASHER69

Board Regular
Joined
Mar 29, 2012
Messages
200
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 5/20/2014 in column A. It should insert a row after the last row of that date also and insert the note from sh2. I think it is in the part of the code I made red but I do not know how to fix it. 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
                    [COLOR=#ff0000]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[/COLOR]
                        End If
                        Exit Do
                    End If
                    fLoc = sh2.Range("E:E").FindNext(fLoc)
                Loop While fAdr <> fLoc.Address
            End If
    Next


sh1 after running the code:
[TABLE="width: 1199"]
<tbody>[TR]
[TD] 5/22/14[/TD]
[TD] 5/20/14[/TD]
[TD]29A14269[/TD]
[TD]3"8V PCSB W/1.5"COMP"G"CONE,HS[/TD]
[TD]0001462494[/TD]
[TD]71803[/TD]
[TD]4[/TD]
[TD]LUFKIN MIDDLE EAST - FREE ZONE[/TD]
[/TR]
[TR]
[TD="colspan: 8"]Credit Hold[/TD]
[/TR]
[TR]
[TD] 5/29/14[/TD]
[TD] 5/23/14[/TD]
[TD]21050116[/TD]
[TD]1.12"-1.5"T302 ROD ROT W/ BC26[/TD]
[TD]0001463802[/TD]
[TD]71803[/TD]
[TD]25[/TD]
[TD]LUFKIN MIDDLE EAST - FREE ZONE[/TD]
[/TR]
[TR]
[TD="colspan: 8"]Credit Hold[/TD]
[/TR]
[TR]
[TD] 5/30/14[/TD]
[TD] 3/27/14[/TD]
[TD]12049401[/TD]
[TD]5/8"-1"SET OF BUNA-N RAMS(2)[/TD]
[TD]0001457885[/TD]
[TD]T00103577[/TD]
[TD]36[/TD]
[TD]NATIONAL DRILLING SERVICES CO, LLC[/TD]
[/TR]
[TR]
[TD] 5/30/14[/TD]
[TD] 3/27/14[/TD]
[TD]12049402[/TD]
[TD]1.12" SET OF BUNA-N RAMS (2)[/TD]
[TD]0001457885[/TD]
[TD]T00103577[/TD]
[TD]32[/TD]
[TD]NATIONAL DRILLING SERVICES CO, LLC[/TD]
[/TR]
[TR]
[TD] 5/30/14[/TD]
[TD] 3/27/14[/TD]
[TD]12049403[/TD]
[TD]1.25" SET OF BUNA-N RAMS (2)[/TD]
[TD]0001457885[/TD]
[TD]T00103577[/TD]
[TD]12[/TD]
[TD]NATIONAL DRILLING SERVICES CO, LLC[/TD]
[/TR]
[TR]
[TD] 6/2/14[/TD]
[TD] 5/22/14[/TD]
[TD]21203006[/TD]
[TD]1.5"FIGURE 3 HINGE CLAMP[/TD]
[TD]0001463603[/TD]
[TD]71803[/TD]
[TD]150[/TD]
[TD]LUFKIN MIDDLE EAST - FREE ZONE[/TD]
[/TR]
[TR]
[TD="colspan: 8"]Credit Hold[/TD]
[/TR]
[TR]
[TD] 6/5/14[/TD]
[TD] 5/29/14[/TD]
[TD]37210305[/TD]
[TD]1"2000# 210 BV-1PC[/TD]
[TD]0001464300[/TD]
[TD]66602[/TD]
[TD]50[/TD]
[TD]KEN MILLER SUPPLY, INC[/TD]
[/TR]
[TR]
[TD="colspan: 8"]Due 6-2 EMC -> ABC


sh2 is the sheet it's getting the notes from:
[TABLE="width: 1024"]
<tbody>[TR]
[TD] 5/22/14[/TD]
[TD] 5/20/14[/TD]
[TD]29A14269[/TD]
[TD]3"8V PCSB W/1.5"COMP"G"CONE,HS[/TD]
[TD]0001462494[/TD]
[TD]71803[/TD]
[TD]4[/TD]
[TD]LUFKIN MIDDLE EAST - FREE ZONE[/TD]
[/TR]
[TR]
[TD="colspan: 8"]Credit Hold[/TD]
[/TR]
[TR]
[TD] 5/29/14[/TD]
[TD] 5/23/14[/TD]
[TD]21050116[/TD]
[TD]1.12"-1.5"T302 ROD ROT W/ BC26[/TD]
[TD]0001463802[/TD]
[TD]71803[/TD]
[TD]25[/TD]
[TD]LUFKIN MIDDLE EAST - FREE ZONE[/TD]
[/TR]
[TR]
[TD="colspan: 8"]Credit Hold[/TD]
[/TR]
[TR]
[TD] 5/30/14[/TD]
[TD] 3/27/14[/TD]
[TD]12049401[/TD]
[TD]5/8"-1"SET OF BUNA-N RAMS(2)[/TD]
[TD]0001457885[/TD]
[TD]T00103577[/TD]
[TD]36[/TD]
[TD]NATIONAL DRILLING SERVICES CO, LLC[/TD]
[/TR]
[TR]
[TD] 5/30/14[/TD]
[TD] 3/27/14[/TD]
[TD]12049402[/TD]
[TD]1.12" SET OF BUNA-N RAMS (2)[/TD]
[TD]0001457885[/TD]
[TD]T00103577[/TD]
[TD]32[/TD]
[TD]NATIONAL DRILLING SERVICES CO, LLC[/TD]
[/TR]
[TR]
[TD] 5/30/14[/TD]
[TD] 3/27/14[/TD]
[TD]12049403[/TD]
[TD]1.25" SET OF BUNA-N RAMS (2)[/TD]
[TD]0001457885[/TD]
[TD]T00103577[/TD]
[TD]12[/TD]
[TD]NATIONAL DRILLING SERVICES CO, LLC[/TD]
[/TR]
[TR]
[TD="colspan: 8"]Credit Hold[/TD]
[/TR]
[TR]
[TD] 6/2/14[/TD]
[TD] 5/22/14[/TD]
[TD]21203006[/TD]
[TD]1.5"FIGURE 3 HINGE CLAMP[/TD]
[TD]0001463603[/TD]
[TD]71803[/TD]
[TD]150[/TD]
[TD]LUFKIN MIDDLE EAST - FREE ZONE[/TD]
[/TR]
[TR]
[TD="colspan: 8"]Credit Hold[/TD]
[/TR]
[TR]
[TD] 6/5/14[/TD]
[TD] 5/29/14[/TD]
[TD]37210305[/TD]
[TD]1"2000# 210 BV-1PC[/TD]
[TD]0001464300[/TD]
[TD]66602[/TD]
[TD]50[/TD]
[TD]KEN MILLER SUPPLY, INC[/TD]
[/TR]
[TR]
[TD="colspan: 8"]Due 6-2 EMC -> ABC[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
</tbody>[/TABLE]
 

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
Sort by date Sort by votes
Added a couple of links to download the sheets if anyone would like. Please ignore the date in my first posting. These sheets change daily and this is another set. The problem is the same any dates that are on multiple rows gets skipped over. all the dates that just have a single row work fine

Here is a link to sh1 for download if needed:
https://drive.google.com/file/d/0B1KIaMHlyPjDdVAyX3pZa1dWOVk/edit?usp=sharing

And the link for sh2:
https://drive.google.com/file/d/0B1KIaMHlyPjDUkI5NEZfZlB5VDA/edit?usp=sharing
 
Upvote 0
You must log in or register to reply here.

Similar threads

D
  • Solved
Count total award value per unique supplier
Replies
4
Views
124
Fluff
Fluff
G
  • Question Question
Fuzzy Match code
Replies
1
Views
2K
gelu
G
J
  • Question Question
Extract Names from long String with specific criteria?
2
Replies
13
Views
2K
jeffcoleky
J
T
  • Question Question
Macro to Compare to Sheets and Copy Notes
2
Replies
13
Views
1K
THRASHER69
T
J
  • Question Question
Formatting: Formatting based upon cell color on another sheet
2
Replies
14
Views
2K
blane245
B

Forum statistics

Threads
1,224,607
Messages
6,179,871
Members
452,948
Latest member
UsmanAli786

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top