View Single Post
  #6   Report Post  
Posted to microsoft.public.excel.misc
joeu2004[_2_] joeu2004[_2_] is offline
external usenet poster
 
Posts: 829
Default is it possible to ask excel to input from another sheet?

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