This macro should work for you:

Code
-------------------
Sub createList()
' Declare variables...
Dim pgStart, pgEnd, newRow, counter As Integer
Dim myTitle, ansKey, pgRng, newString, string2 As String

' Select Sheet1 first cell w/data (A2)...
ThisWorkbook.Sheets(1).Activate
ActiveSheet.Range("A2").Select
' Initialize counter
counter = 0
' Loop through all rows of data and populate Sheet2...
Do Until IsEmpty(ActiveCell)
' Count data rows to process
counter = counter + 1
' Get title...
myTitle = ActiveCell.Value
' Get page start...
pgStart = ActiveCell.Offset(0, 1).Value
' Get page end...
pgEnd = ActiveCell.Offset(0, 2).Value
' Get answer key...
ansKey = ActiveCell.Offset(0, 3).Value
' Determine page range and format accordingly...
If pgEnd pgStart Then
pgRng = "pp. " & pgStart & "-" & pgEnd
Else
pgRng = "p. " & pgStart
End If
' Concatenate data and populate Sheet2...
newString = myTitle & ", " & pgRng & ", " & ansKey
'Determine first empty row in Sheet2 to populate
If counter = 1 Then
newRow = ThisWorkbook.Sheets(2).UsedRange.Rows.Count
Else
newRow = ThisWorkbook.Sheets(2).UsedRange.Rows.Count + 1
End If
' Populate Sheet2 accordingly (2 records if answer key present)...
If ansKey < "" Then
newString = myTitle & ", " & pgRng & ", " & "answer key"
string2 = myTitle & ", " & pgRng
ThisWorkbook.Sheets(2).Cells(newRow, 1).Value = newString
ThisWorkbook.Sheets(2).Cells(newRow + 1, 1).Value = string2
Else
ThisWorkbook.Sheets(2).Cells(newRow, 1).Value = newString
End If
' Go to next row of data...
ActiveCell.Offset(1, 0).Select
Loop
' Switch to Sheet 2 to show results...
ThisWorkbook.Sheets(2).Activate
ActiveSheet.Range("A1").Select
End Su
-------------------

Hope this helps,
theDud

--
theDud
-----------------------------------------------------------------------
theDude's Profile: http://www.excelforum.com/member.php...fo&userid=1655
View this thread: http://www.excelforum.com/showthread.php?threadid=46715