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.
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:
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 Credit Hold 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 Credit Hold 6/2/14 5/22/14 21203006 1.5"FIGURE 3 HINGE CLAMP 0001463603 71803 150 LUFKIN MIDDLE EAST - FREE ZONE Credit Hold
Why start on row 7 here:
Set rng = sh1.Range("E7:E" & lr)
when the data on both sheets (from your cross post) start in row 2?
It is difficult to work out which sheet is which when you haven't retained their names; could you supply 1 file with both sheets in, properly named and the code you've been trying.
Also, in words, what are you trying to do? (It's difficult to work out what you want to happen from code which isn't doing what it's supposed to do.) I think the code needs a re-write.
Would you be happy working without merged cells? They are a real pain with vba.
Yes, this has been posted on other boards. I wasn't getting any replies and thought I had waited long enough to post here. If I did not my apologies. I do not want to step on any toes
Yes, this has been posted on other boards. I was not getting any replies and thought I had waited long enough to post here. If I did not, my apologies. I do not want to step on any toes. I am just trying to solve this issue.
The code very well could need a rewrite. Attached below is the spreadsheet with the code. Everyday the Back Orders (sh1) changes. That sheet is saved to the BO Save (sh2) with any new notes. I'm wanting the macro to insert a line where needed on sheet "Back Orders", copy the note for that date from sheet "BO Save" and copy it into the newly inserted line on sheet "Back Orders". I need it to do these for each date. Right now with the code I have it will insert and copy on each line that has a single date but if the sheet has multiple rows with the same date it just skips inserting the note on them. Here is the sheet which will show why I am starting on row 7 also.
BTW, thank for the reply and the interest in maybe helping me.
BO Report.xlsm
The cross posting thing is pretty universal amongst forums etc. Some moderators ban users/lock threads where it happens incorrectly. What most boards want is that you link to all your cross posts and prefereably update each one if/when the problem is solved. ExcelGuru has a page on the topic: http://www.excelguru.ca/content.php?...-cross-postersOriginally Posted by THRASHER
The note is the merged row with red text right?
Does is pertain to the single row above it, or sometimes more than one row above it?
Yes the note is the merged row in red text. the note can pertain to a single row or more than one row. It first checks the CO Number in column E and then the Date in Column A to compare the two sheets. If everything matches insert a blank line and copy the note over. In the spreadsheet I uploaded it should put the note from the BO Save sheet under row 9 on the Back Orders sheet because column E and column A match the same columns on the BO Save sheet. Then it will follow the same procedure for the next line and insert and copy under row 10 on the Back Orders sheet because the criteria matches on both sheets. It will follow this process all the way through the sheet. Anything that does not match, it just skips and goes on. I hope I explained that well enough to make sense. Please keep asking. I will get it clear.
Thanks
Try the following code in a standard code module:It runs through the note lines on BOSave, looks for the last instance of CO number on BackOrders, checks the date, if the same then it copies the note across below the found CO Number.Code:Sub blah() Set myNotes = Sheets("BO Save").Range("A8:A49").SpecialCells(xlCellTypeConstants, 2) For Each rw In myNotes.Rows Set FoundCONumber = Sheets("Back Orders").Range("E8:E1000").Find(rw.Offset(-1).Cells(1).Offset(, 4).Value, lookat:=xlWhole, Searchdirection:=2, searchformat:=False) If Not FoundCONumber Is Nothing Then 'Application.Goto rw 'debug line 'Application.Goto FoundCONumber 'debug line If rw.Offset(-1).Cells(1).Value = FoundCONumber.Offset(, -4).Value Then rw.Copy FoundCONumber.Offset(1).EntireRow.Insert Shift:=xlDown Else Application.Goto rw MsgBox "this comment not transferred" End If Else Application.Goto rw.Offset(-1).Cells(1).Offset(, 4) MsgBox "selected number not found on destination sheet" End If Next rw Application.CutCopyMode = False End Sub
It's not robust, it's even flaky. It makes a few assumptions about how the destination sheet is sorted, and doesn't check whether the correct date exists with that CO Number, however, it's a start and you need to confirm that it's doing more or less the right thing.
Posting Permissions
Reply With Quote
Bookmarks