View Single Post
  #7   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?

"sumesh56" wrote:
the seating plan says that in XII-A Examroom students belonging
to classes XI-A,X-A,IX-B AND VIII-A are accomodated.
thus total of 40 students are accomodated in XII-A.
There are 36 students in class XI-A ROLL NUMBERS 601-636.
they are accomodated in four examrooms viz XII-A,XII-B,XI-A AND X-B.
We have assigned rollnumbers like this-- 601 to 650 will be in
class XI-A and 651 to 699 will be in class XI-B.
[....] is it possible to connect something with the rollnumbers?


Yes. I did not have the benefit of this design information before.

(Re)Download download "test seating plan 210314.xlsm" from
https://app.box.com/s/f7yddu2xcrki8wx5mr8t. I have updated the marco to
take advantage of the meaning of the roll numbers.

Also, I took the liberty of changing the titles in column B of the Seating
worksheet to "EXAM ROOM", since that seems to be your intent.

(I never did understand why column B was titled "CLASS" in both worksheets.)

The VBA implementation could still be optimized to avoid the O(n*(n+1)/2)
search time. And it is always prudent to toggle Application.ScreenUpdating,
Calculation mode and EnableEvents.

Again, I do not bother because the macro is fast enough for the example, and
it is easier to understand as written for now.

-----

Updated macro....

Option Explicit

Sub makeDistrib()
Dim vDistrib As Variant, vData As Variant
Dim nSeating As Long, nDistrib As Long, nData As Long
Dim i As Long, j As Long, nRows As Long
Dim r As Range, nr As Long
Dim distribWS As Worksheet, seatingWS As Worksheet
Dim newDistrib As String, className As String, roomName As String

'**** CUSTOMIZE ****
Set distribWS = Sheet1 ' template
Set seatingWS = Sheet2
newDistrib = "NEW " & distribWS.Name

nRows = Rows.Count

' copy in seating data.
' trim and copy seating room names.
' also trim distribution class names to facilitate match later.
' NOTE: i=i+1 assumes at least one line of separation between
' seating tables
With seatingWS
nData = .Cells(nRows, "e").End(xlUp).Row
vData = .Range("b1", .Cells(nData, "e"))
End With
ReDim vSeating(1 To nData, 1 To 4) As Variant
i = 1: nSeating = 0
Do
If LCase(vData(i, 1)) = "exam room" Then
i = i + 1
roomName = Trim(vData(i, 1))
Do While vData(i, 2) < ""
nSeating = nSeating + 1
vSeating(nSeating, 1) = roomName
vSeating(nSeating, 2) = Trim(vData(i, 2))
vSeating(nSeating, 3) = vData(i, 3)
vSeating(nSeating, 4) = vData(i, 4)
i = i + 1
If i nData Then Exit Do
Loop
End If
i = i + 1
Loop Until i = nData

' sort by roll number
Sheets.Add befo=Sheets(1)
Set r = Range("a1:d" & nSeating)
r = vSeating
r.Sort Key1:=r.Cells(1, 3), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
vSeating = r
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True

' copy Distribution template
distribWS.Copy befo=Sheets(1)
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

' copy in distribution tables
nDistrib = Cells(nRows, "b").End(xlUp).Row
vDistrib = Range("b1", Cells(nDistrib, "b"))

' for each distribution table, copy seating data.
' NOTE: i=i+1 assumes at least one line of separation between
' distribution tables
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 Exit For
Next
If j <= nSeating Then
Do
Range("c" & i) = vSeating(j, 1)
Range("d" & i) = vSeating(j, 3)
Range("e" & i) = vSeating(j, 4)
i = i + 1
j = j + 1
If j nSeating Then Exit Do
Loop Until vSeating(j, 2) < className
End If
End If
i = i + 1
Loop Until i = nDistrib
MsgBox "done"
End Sub