Struggling to sort matching orders into groups & add product names to break lines between.

[RaptureAG]

I am not that advanced with excel and for a few days I have been trying out code with no success. Please help
How do I create a macro to sort rows into groups, add break rows in between & insert a product sourced from another excel workbook onto the break line?

I receive a spreadsheet each day with a series of requests, most of the information is the addresses & names etc with the important data in columns K,M & O. Data in each of these columns is a code that refers to a product and information sheet to be sent out to the person requesting it. They may want just one in which case data will only be in column K, if they want two there will also be data in M and if they require three there will be data in column O as well. The bit I do know is how to sort the important data into groups of the same by the country (column I) and the product sku's.

Whilst I can do the sort as a recorded macro I really need it to be part of a larger macro that does the following bit I can't get my head around. I need to insert a break row above each group then by cross referencing the data in the product sku columns to a separate workbook insert the appropriate item / letter combination onto the break line row, telling the volunteer which items to send out. This is a v look up?

I have attached an example of the files we work with, the first tab is with the data simply sorted and the second is what I need it to look like. I normally receive it as a CSV file, there are around 8000 possible combinations of product and instructions and the files are normally around 4000 records long. At present we insert the break lines and copy/paste the information manually, seriously slowing down the process.

Orders Example EUR RM.xlsx

[jaslake]

Hi Rapture

Welcome to the Forum!!

You indicate you have a Sort Routine. I'd like to see your Unsorted Data AND the Sort Routine you've developed.

In your Sample File, Product Information Requests extend out to three...is three the limit? Is there a limit?

To accommodate this we'd need to see the File and understand the Cross Reference

insert a product sourced from another excel workbook onto the break line

[RaptureAG]

Hello jaslake

Thanks for the reply & the warm welcome.

Firstly, there is no limit to the number of requests but the most I have ever seen is 5 and the least 2. If there are more than the 3 in my sample, each adds two columns, 1 for Product name & 1 for product sku.

When I get the CSV file it looks just like the data on the first page but the rows are in no particular order whatsoever.

My sort routine is just a custom sort on the toolbar by the columns Ship Country, Product 1 Sku #, Product 2 Sku #, Product 3 Sku # etc. I copy the data onto a macro enabled workbook where I have recorded it as a basic macro and put buttons on the page for requests of 2,3,4 & 5 items. I then identify where the changes in products are and manually enter a break row above.

My process at the moment is then to have the csv file & the product letter skus file open, copy the product sku from the csv onto the clipboard and paste it into a 'find and replace' on the other. I then copy the information in the components column and paste it into the appropriate break line back on the csv file.

I have attached a sample of the product letter skus file that includes all the skus on my sample data, the full file is several hundred lines long.

Let me know, should you need further info, in the meantime, I am very thankful for your help.

[jaslake]

Hi Rapture

This Code will deal with up to 5 requests...add as many Offsets as you wish to accommodate more.

Option Explicit

Sub test()
  Dim ws As Worksheet
  Dim rng As Range, cel As Range
  Dim LR As Long, i As Long

  Application.ScreenUpdating = False
  Set ws = Sheet1
  With ws
    LR = .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), SearchOrder:=xlByRows, _
                     SearchDirection:=xlPrevious).Row
    Set rng = .Range("I2:I" & LR)
    With rng
      For i = LR To 2 Step -1
        If Not rng(i) & rng(i).Offset(0, 2) & rng(i).Offset(0, 4) & rng(i).Offset(0, 6) & rng(i).Offset(0, 8) & rng(i).Offset(0, 10) _
            = rng(i).Offset(-1, 0) & rng(i).Offset(-1, 2) & rng(i).Offset(-1, 4) & rng(i).Offset(-1, 6) & rng(i).Offset(-1, 8) & rng(i).Offset(-1, 10) Then
          rng(i).EntireRow.Insert
        End If
      Next i
    End With
  End With
  Application.ScreenUpdating = True
End Sub

I'll need to look a bit further at this to understand the requirements

insert the appropriate item / letter combination onto the break line row

[RaptureAG]

That's excellent jaslake, it works perfectly. Just in time for our Public Holiday next week, too. The file on the first day back after one of those is always horrifically long.

Just to clarify on the second part, what is needed is to look up the product sku (columns K,M,O,Q & S of the orders workbook) in the product and letters workbook where they appear in column B under 'Offer SKU' then bring back the corresponding components from column G and populate the break line above each block of rows. The components from the first product sku need to be in column B on the break row, the 2nd in C, 3rd in D, 4th in E & 5th in F.

Hope that helps.

[jaslake]

Hi Rapture

You'll need to tell me...the Code assumes the Orders File and the Product Letters SKUs File are in the same Folder. The Code will open the Product Letters File it it's not open.

Option Explicit

Sub test()
  Dim wsTgt As Worksheet, wsSrc As Worksheet
  Dim wbTgt As Workbook, wbSrc As Workbook
  Dim rng As Range, cel As Range, c As Range
  Dim LRTgt As Long, i As Long, j As Long
  Dim myPath As String

  Application.ScreenUpdating = False
  Set wbTgt = ThisWorkbook
  myPath = wbTgt.Path & "\"

  Set wsTgt = Sheet1
  With wsTgt
    LRTgt = .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), SearchOrder:=xlByRows, _
                        SearchDirection:=xlPrevious).Row
    Set rng = .Range("I2:I" & LRTgt)
    With rng
      For i = LRTgt To 1 Step -1
        If Not rng(i) & rng(i).Offset(0, 2) & rng(i).Offset(0, 4) & rng(i).Offset(0, 6) & rng(i).Offset(0, 8) & rng(i).Offset(0, 10) _
         = rng(i).Offset(-1, 0) & rng(i).Offset(-1, 2) & rng(i).Offset(-1, 4) & rng(i).Offset(-1, 6) & rng(i).Offset(-1, 8) & rng(i).Offset(-1, 10) Then
          rng(i).EntireRow.Insert
        End If
      Next i
    End With
  End With

  If CheckFileIsOpen("Product Letter SKUs.xlsx") = False Then
    Workbooks.Open myPath & "Product Letter SKUs.xlsx"
  End If

  Set wbSrc = Workbooks("Product Letter SKUs.xlsx")
  Set wsSrc = wbSrc.Sheets("Sheet1")

  With wsTgt
    .Activate
    LRTgt = .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), SearchOrder:=xlByRows, _
                        SearchDirection:=xlPrevious).Row
    Set rng = .Range(.Cells(1, "K"), .Cells(LRTgt, "K")).SpecialCells(xlCellTypeBlanks)
    For Each cel In rng
      j = 2
      For i = 0 To 8 Step 2
        If Not IsEmpty(cel.Offset(1, i)) Then
          With wsSrc.Columns(2)
            Set c = .Find(cel.Offset(1, i).Value, LookIn:=xlValues)
            If Not c Is Nothing Then
              wsTgt.Cells(cel.Row, j).Value = wsSrc.Cells(c.Row, "G").Value
              j = j + 1
            End If
          End With
        End If
      Next i
    Next cel
    .Columns.AutoFit
  End With
  Application.ScreenUpdating = True
End Sub



Function CheckFileIsOpen(chkSumfile As String) As Boolean
  On Error Resume Next
  CheckFileIsOpen = (Workbooks(chkSumfile).Name = chkSumfile)
  On Error GoTo 0
End Function

[RaptureAG]

That works like a dream, yes the two workbooks will be in the same folder.

I am hitting a couple of snags, the data does not normally arrive in country order although the sample I uploaded had been. When I used the first script today it blocked together like product skus perfectly but it didn't sort the countries. Is there an adjustment you can make that will keep each country together. The second issue is when I enter the two codes together I get an error message, do I need to do something to run them together as one function?

Thanks

[jaslake]

Hi Rapture

If you'll post your UNSORTED File WITH your Sort Code I'll be glad to look at it and marry the Routines.

Edit:
Sorry, I misread...you don't HAVE a Sort Routine...you Sort from the Toolbar.

Record those key strokes...post the Code...give me an unsorted File.

What two Codes are you referring to here...what Error Message do you get?

The second issue is when I enter the two codes together I get an error message, do I need to do something to run them together as one function?

[RaptureAG]

Apologies, ignore that bit about the code / error message, I hadn't completely overwritten the first version in the Visual Basic box. I've corrected my mistake now.

With the sort, I do use the toolbar and enter an up to 6 level custom sort by 'ship country', then 'product 1 sku #', 'product 2 sku #' through to 'product 5 sku #' . Then enter the breaks, then manually get the components.

I've randomized the order numbers on the reattached file, this is what the file would look like when it arrives. The reason we sort it by country is after it's all sorted we use mail merge to print address labels and the components in the break rows print on a label, effectively giving a picking list for the next batch of labels. Each volunteer gets a different country to do as there are different collectors or couriers for each country.

The code that the macro records when I do it is

Sub SortCode()
'
' SortCode Macro
' s
'
' Keyboard Shortcut: Ctrl+s
'
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("I2:I4232" _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("K2:K4232" _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("M2:M4232" _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("O2:O4232" _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("Q2:Q4232" _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("S2:S4232" _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
.SetRange Range("A1:S4232")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub

This looks like it has limited the number of rows in the sort to those that are active, we could effectively have an unlimited number of rows.

Thanks again.

[jaslake]

Hi Rapture

I'll look at this...point of Forum Requirements...please wrap any Code you post in Code Tags.

To do so, in your Original Post, highlight your code and click the # icon at the top of your post window.

[jaslake]

Hi Rapture

Try the Code in the attached...this is not an issue

This looks like it has limited the number of rows in the sort to those that are active, we could effectively have an unlimited number of rows.

[RaptureAG]

Thank you so very much, jaslake, that has just saved me & my administrator a heck of a lot of tedious drudgery that we have to go through twice a day.

Simply because I knew this could probably be done with macros the board are now looking at sending me on an Excel course.

[jaslake]

You're welcome...glad I could help. Thanks for the Rep.