View Single Post
  #7   Report Post  
Posted to microsoft.public.excel.worksheet.functions
Otto Moehrbach[_2_] Otto Moehrbach[_2_] is offline
external usenet poster
 
Posts: 1,071
Default Need Simple List...Multiple Columns and Multiple Worksheets

Jane

Here is a series of macros that do what you want. I made the
following assumptions:

Your original 3 sheets are named: "Sheet One", "Sheet Two", and "Sheet
Three", without the quotes.

Your destination sheets are named: "Grade pre-k", "Grade k", "Grade 1",
"Grade 2". Etc. to "Grade 8", again without the quotes.

I included code in the macros to handle the situation wherein one family has
twins or triplets or whatever (multiple children in the same grade).

This code may be more than you can handle, so, if you wish, send me an email
and I'll send you the small file I used to develop the code. That file will
have the code properly placed. My email address is
. Remove the "extra" from this address. HTH
Otto

Option Explicit
Dim ws As Worksheet, Grade As Variant, DestSht As String
Dim rColA As Range, i As Range, Dest As Range
Dim NumTwins As Long



Sub ArrangByGrade()
Application.ScreenUpdating = False
Call ClearGradeShts
Call FilterData
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub



Private Sub ClearGradeShts() 'Clears all data in all grade sheets
For Each ws In ActiveWorkbook.Worksheets
If Left(ws.Name, 5) = "Grade" Then
With ws
If Not IsEmpty(.Range("A2")) Then _
.Range("A2", .Range("A" &
Rows.Count).End(xlUp)).ClearContents
End With
End If
Next ws
End Sub



Private Sub FilterData()
For Each Grade In Array("pre-k", "k", "1", "2", "3", "4", "5", "6",
"7", "8")
If IsNumeric(Grade) Then Grade = CInt(Grade)
Call GetDestSht
Set Dest = Sheets(DestSht).Range("A2")
For Each ws In Sheets(Array("Sheet One", "Sheet Two", "Sheet
Three"))
With ws
Set rColA = .Range("A2", .Range("A" &
Rows.Count).End(xlUp))
End With
For Each i In rColA
If Application.CountIf(i.Offset(, 6).Resize(, 4),
Grade) 0 Then
NumTwins = Application.CountIf(i.Offset(,
6).Resize(, 4), Grade)
i.Resize(, 6).Copy 'copy first 6 columns
Dest.Resize(NumTwins).PasteSpecial
xlPasteValues
i.Offset(, 10).Copy 'copy 11th column
Dest.Offset(, 6).PasteSpecial xlPasteValues
Set Dest =
Dest.End(xlUp).End(xlDown).Offset(1)
End If
Next i
Next ws
Next Grade
End Sub



Private Sub GetDestSht()
Select Case Grade
Case "pre-k": DestSht = "Grade pre-k"
Case "k": DestSht = "Grade k"
Case "1": DestSht = "Grade 1"
Case "2": DestSht = "Grade 2"
Case "3": DestSht = "Grade 3"
Case "4": DestSht = "Grade 4"
Case "5": DestSht = "Grade 5"
Case "6": DestSht = "Grade 6"
Case "7": DestSht = "Grade 7"
Case "8": DestSht = "Grade 8"
End Select
End Sub


"Jane Doe" wrote in message
...

Otto,

Thought I might mention that if there are only 2 children, there will be 2
columns blank...child1=pk, child2=7, child3=blank, child4=blank.