PS.... I wrote:
"joeu2004" wrote in message
...
For one VBA implementation, download "test seating plan 210314.xlsm" from
https://app.box.com/s/f7yddu2xcrki8wx5mr8t. For posterity, I include the
macro text below.
Some after-thoughts....
I might note that the implementation is not as efficient as it might be.
But it is sufficiently fast for the example. And I think the design is
easier to understand than a more efficient algorithm.
Also, I forgot to "include the macro text below" for posterity. Here it is.
-----
Option Explicit
Sub makeDistrib()
Dim vSeating As Variant, vDistrib As Variant
Dim nSeating As Long, nDistrib As Long
Dim i As Long, j As Long, nRows As Long
Dim r As Range, nr As Long, nc As Long
Dim distribWS As Worksheet, seatingWS As Worksheet
Dim newDistrib As String, className As String
'**** CUSTOMIZE ****
Set distribWS = Sheet1 ' template
Set seatingWS = Sheet2
' copy Distribution template
distribWS.Copy Befo=Sheets(1)
newDistrib = "NEW " & distribWS.Name
On Error Resume Next
ActiveSheet.Name = newDistrib
If Err < 0 Then
' delete worksheet with duplicate name
Application.DisplayAlerts = False
Sheets(newDistrib).Delete
Application.DisplayAlerts = True
ActiveSheet.Name = newDistrib
End If
On Error GoTo 0
nRows = Rows.Count
' copy in seating data
With seatingWS
nSeating = .Cells(nRows, "e").End(xlUp).Row
vSeating = .Range("b1", .Cells(nSeating, "e"))
End With
' fill in and trim seating class names.
' also trim distribution class names to
' facilitate match later
i = 1
Do
If LCase(vSeating(i, 1)) = "class" Then
i = i + 1
className = Trim(vSeating(i, 1))
Do While vSeating(i, 2) < ""
vSeating(i, 1) = className
vSeating(i, 2) = Trim(vSeating(i, 2))
i = i + 1
If i nSeating Then Exit Do
Loop
End If
i = i + 1
Loop Until i = nSeating
' copy in distribution tables
nDistrib = Cells(nRows, "b").End(xlUp).Row
vDistrib = Range("b1", Cells(nDistrib, "b"))
' for each distribution table, copy seating data
i = 1
Do
If LCase(vDistrib(i, 1)) = "class" Then
' clear Distribution template
i = i + 1
Set r = Cells(i, "b").MergeArea
nr = r.Rows.Count
Range("c" & i & ":e" & i + nr - 1).ClearContents
' copy seating data
className = Trim(vDistrib(i, 1))
For j = 1 To nSeating
If vSeating(j, 2) = className Then
' copy seating data
Range("c" & i) = vSeating(j, 1)
Range("d" & i) = vSeating(j, 3)
Range("e" & i) = vSeating(j, 4)
i = i + 1
End If
Next j
End If
i = i + 1
Loop Until i = nDistrib
MsgBox "done"
End Sub