Need to select/report all rows based on content

[Guest]

My workbook has worksheets for each year.
In each worksheets is a list of papers published in our department. The
columns of each worksheet represent Authors, Article Title, Citation
information.
On a new sheet (I guess, because I need to be able to do it to any of the
sheets without messing them up), I need to generate a list of all of the
publications for the department by year (sheet) for each author. For example,
I have the list of publications from 2005, but it lists each paper only once,
whereas I need to generate a list by author that will (therefore) duplicate
the papers. Sorting only gets me part of the way because it provides all of
the papers by each first author, but doesn't consider any other authors.
I'll provide the illustrations below.
Let me know if I can provide any additional information.

What I have:
Column A Column B Column C
Schmidt R, Klimo Jr P Cerebral vasospasm ... In Cerebral
Vasospasm pp...
Gottfried ON, Smith WT Review of ... N Engl J Med
351:1493-...
Gottfried ON, Binning ML Surgical approaches... Contemp.
Neurosurg. 27:1-8

What I need to calculate out of that:
Column A Column B Column C
SCHMIDT R
Schmidt R, Klimo Jr P Cerebral vasospasm ... In Cerebral
Vasospasm pp...
KLIMO JR P
Schmidt R, Klimo Jr P Cerebral vasospasm ... In Cerebral
Vasospasm pp...
GOTTFRIED ON
Gottfried ON, Smith WT Review of ... N Engl J Med
351:1493-...
Gottfried ON, Binning ML Surgical approaches... Contemp.
Neurosurg. 27:1-8
SMITH WT
Gottfried ON, Smith WT Review of ... N Engl J Med
351:1493-...
BINNING ML
Gottfried ON, Binning ML Surgical approaches... Contemp.
Neurosurg. 27:1-8

 

[Guest]

Kristin,
Are the authors always on, and only on, the first line of
an entry? And are they always delimited by a comma?

 

[Guest]

HTH

Sub Extract()

Dim lastrow As Long, Authors As Variant
Dim ws1 As Worksheet, ws2 As Worksheet
Dim lastrow As Long, r As Long, nextr As Long, nrow As Long

Set ws1 = Worksheets("sheet1")
Set ws2 = Worksheets("sheet2")

orow = 2

With ws1
lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
ws1.Cells(1, 1).Resize(1, 3).Copy ws2.Cells(1, 1)
r = 2

Do
nextr = .Cells(r, 3).End(xlDown).Row
If nextr > lastrow Then
nrow = lastrow - r + 1
Else
nrow = nextr - r
End If
' Get authors
Authors = Split(.Cells(r, 1), ",")
For j = LBound(Authors) To UBound(Authors)
ws1.Cells(r, 1).Resize(nrow, 3).Copy ws2.Cells(orow, 1)
ws2.Cells(orow, 1) = Trim(Authors(j)) ' replace with author
orow = orow + nrow
Next j
r = r + 2
Loop Until r >= lastrow

End With

End Sub

 

[Guest]

I appreciate your help. I just put this in as a macro. Is that correct?
This results in an error "Duplicate declaration in current scope." for this
part:
lastrow As Long.

The authors are always in the first column and always separated by commas.
Thanks,
Kristin

 

[Guest]

Kristin,
Yes, add as macro and remove one of the "DIM lastrow as
Long" statements.

 

[Guest]

I tried removing the second "DIM..." and then replaced that and tried
removing the first, but each time I got "Compile error: Statement invalid
outside type block" for the text that immediately follows what I removed.

I greatly appreciate your help.
Kristin

 

[Guest]

Reposting code: worksOK for me

Sub Extract()

Dim Authors As Variant
Dim ws1 As Worksheet, ws2 As Worksheet
Dim lastrow As Long, r As Long, nextr As Long, nrow As Long

Set ws1 = Worksheets("sheet1")
Set ws2 = Worksheets("sheet2")

orow = 2

With ws1
lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
ws1.Cells(1, 1).Resize(1, 3).Copy ws2.Cells(1, 1)
r = 2

Do
nextr = .Cells(r, 3).End(xlDown).Row
If nextr > lastrow Then
nrow = lastrow - r + 1
Else
nrow = nextr - r
End If
' Get authors
Authors = Split(.Cells(r, 1), ",")
For j = LBound(Authors) To UBound(Authors)
ws1.Cells(r, 1).Resize(nrow, 3).Copy ws2.Cells(orow, 1)
ws2.Cells(orow, 1) = Trim(Authors(j)) ' replace with author
orow = orow + nrow
Next j
r = r + 2
Loop Until r >= lastrow

End With

End Sub