What Discrete Optimization family is this?

Question

I am given N lists of M items that will be physically realized (someone actually has to put items (names abbreviated here,) in physical bins.) Then the bins are emptied, if necessary, and re-used, working left-to-right. There is a real cost to putting a different item in a bin than what was in it before. I rearrange the lists to minimize changes, manually. Software can do it faster, and more reliably in an optimum way. The whole thing happens in Excel (then paper, then in a factory.) I wrote some VBA, a brute-force affair, that did really well with some examples. But not all. If I knew the family of optimization that this is, I could code it, even if I just pass something to a DLL. But multiple searches online have not succeeded. I tried several phrasings. It's not a traveling S.., knapsack, etc. It seems similar to the Sequence Alignment problem from Bioinformatics. Someone recognize it? Let's hear it, Operations Research people.

Answer 1

As it turns out, the naive solution just needed tweaking. Look at a cell. Try to find the same letter in the column to it's right. If you find one, swap it with whatever it to the right of that cell now. Work your way down. The ColumnsPer parameter accounts for the real-world use, where each column has an associated list of numbers and the grid columns alternate labels, numbers, labels, ...

Option Explicit
Public Const Row1 As Long = 4
Public Const ColumnsPer As Long = 1  '2, when RM, % 
Public Const BinCount As Long = 6  
Public Const ColCount As Long = 6

Private Sub reorder_items_max_left_to_right_repeats(wksht As Worksheet, _
    col1 As Long, maxBins As Long, maxRecipes As Long, ByVal direction As Integer)

    Dim here As Range
    Set here = wksht.Cells(Row1, col1)
        here.Activate
        
    Dim cond
    For cond = 1 To maxRecipes - 1
        Do While WithinTheBox(here, col1, direction)
            If Not Adjacent(here, ColumnsPer).Value = here.Value Then
                   Dim there As Range
                   Set there = Matching_R_ange(here, direction)
                If Not there Is Nothing Then swapThem Adjacent(here, ColumnsPer), there
            End If
NextItemDown:
            Set here = here.Offset(direction, 0)
                here.Activate
                'Debug.Assert here.Address <> "$AZ$6"
          DoEvents
        Loop
NextCond:
        Select Case direction
            Case 1
                Set here = Cells(Row1, here.Column + ColumnsPer)
            Case -1
                Set here = Cells(Row1 + maxBins - 1, here.Column + ColumnsPer)
        End Select
        here.Activate
    Next cond
End Sub

Function Adjacent(fromHereOnLeft As Range, colsRight As Long) As Range
    Set Adjacent = fromHereOnLeft.Offset(0, colsRight)
End Function

Function Matching_R_ange(fromHereOnLeft As Range, _
                         ByVal direction As Integer) As Range
    
    Dim rowStart As Long
        rowStart = Row1
        
    Dim colLook As Long
        colLook = fromHereOnLeft.Offset(0, ColumnsPer).Column
        
    Dim c As Range
    Set c = Cells(rowStart, colLook)
    
    Dim col1 As Long
    col1 = c.Column
    
    Do While WithinTheBox(c, col1, direction)
        Debug.Print "C " & c.Address
    
        If c.Value = fromHereOnLeft.Value _
        And c.Row <> fromHereOnLeft.Row Then
            Set Matching_R_ange = c
            Exit Function
        Else
                Set c = c.Offset(1 * direction, 0)
        End If
      DoEvents
    Loop
    'returning NOTHING is expected, often
End Function

Function WithinTheBox(ByVal c As Range, ByVal col1 As Long, ByVal direction As Integer)
    Select Case direction
        Case 1
            WithinTheBox = c.Row <= Row1 + BinCount - 1 And c.Row >= Row1
        Case -1
            WithinTheBox = c.Row <= Row1 + BinCount - 1 And c.Row > Row1
    End Select
    WithinTheBox = WithinTheBox And _
               c.Column >= col1 And c.Column < col1 + ColCount - 1
End Function

Private Sub swapThem(range10 As Range, range20 As Range)
    'Unlike with SUB 'Matching_R_ange', we have to swap the %s as well as the items
    'So set temporary range vars to hold %s, to avoid confusion due to referencing items/r_anges
    If ColumnsPer = 2 Then
        Dim range11 As Range
        Set range11 = range10.Offset(0, 1)
        
        Dim range21 As Range
        Set range21 = range20.Offset(0, 1)
        'sit on them for now
    End If
    
    Dim Stak As Object
    Set Stak = CreateObject("System.Collections.Stack")
        Stak.push (range10.Value)           'A
        Stak.push (range20.Value)           'BA
                   range10.Value = Stak.pop 'A
                   range20.Value = Stak.pop '_  Stak is empty now, can re-use
                   
    If ColumnsPer = 2 Then
        Stak.push (range11.Value)
        Stak.push (range21.Value)
                   range11.Value = Stak.pop
                   range21.Value = Stak.pop
    End If
End Sub