View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
SudokuKing[_2_] SudokuKing[_2_] is offline
external usenet poster
 
Posts: 1
Default Sort Multiple Sheets by Category


If you want a quick solution, here's a brute force macro that should do
the trick (it doesn't do an alphabetical sort - it just dumps
everything that starts with "A" into sheet "A", and so forth, so
perform a sort first):

Sub SortCategories()
'Takes values from Range A, B, & C of "Summary Sheet" and
'sorts them alphabetically onto sheets labeled "A", "B",....
'NOTE: Runs down column A of "summary sheet" until it
'encounters an empty cell, then stops.

'Assumes:
'Title is in Column A, the Author is in Column B, and Category is
in Column C.
'Worksheet with unsorted data is called "Summary Sheet"
Dim i As Long, j As Long
Dim SummarySh As Worksheet
Dim PasteSh As Worksheet
Dim StRow As Integer
Dim PasteRow As Long

'Change StRow to the number of the first row containing data
StRow = 2
'Change "Summary sheet" to the name of the workbook with data
Set SummarySh = ActiveWorkbook.Worksheets("Summary Sheet")
i = StRow
For i = 1 To 26
Sheets(ColumnLetter(i)).Range("A1").Value = "Title"
Sheets(ColumnLetter(i)).Range("B1").Value = "Author"
Sheets(ColumnLetter(i)).Range("C1").Value = "Category"
Next i
Do While (SummarySh.Range("A" & i).Value < "")
Set PasteSh = Sheets(Left(SummarySh.Range("A" & i).Value, 1))
MsgBox PasteSh.Name
PasteRow = PasteSh.Range("A1").End(xlDown).Row + 1
If PasteRow = 65537 Then PasteRow = 2
PasteSh.Range("A" & PasteRow) = SummarySh.Range("A" & i)
PasteSh.Range("B" & PasteRow) = SummarySh.Range("B" & i)
PasteSh.Range("C" & PasteRow) = SummarySh.Range("C" & i)
i = i + 1
Loop

End Sub

Function ColumnLetter(ByVal ColumnNumber As Integer) As String
If ColumnNumber 26 Then
ColumnLetter = Chr(Int((ColumnNumber - 1) / 26) + 64) &
Chr(((ColumnNumber - 1) Mod 26) + 65)
Else
ColumnLetter = Chr(ColumnNumber + 64)
End If
End Function


--
SudokuKing
------------------------------------------------------------------------
SudokuKing's Profile: http://www.excelforum.com/member.php...o&userid=35868
View this thread: http://www.excelforum.com/showthread...hreadid=556622