Solved: Quite a complicated one...perhaps?

[wa1esy]

Basically I have a sheet that looks a bit like this:

Column A
Smith John
Smith J
Smith JA
Jones Peter
Jones P

Column B to H
various numbers

Column I
Smith J
Smith J
Smith J
Jones P
Jones P

Essentially I have taken this data out of pubmed and have numerous duplicate rows containing data for the same author, so I want to find the duplicates, insert a row directly underneath and then sum the values in columns B to H in the inserted row. e.g I want Excel to work down column I find the three Smith J values, insert a row underneath the last one and then autosum B to H into this blank row and then highlight it (yellow or whatever). I have over 50000 rows so if I could find a piece of code to do this bit then I would be able to go down the sheet and QA the highlighted results.

I have no VBA experience at all, but everytime I do this task manually I can't help thinking that there must be another way. Will somebody please show me the light. I would be eternally grateful.

Many thanks.

[lynnnow]

Can you post your workbook for an example? It will help in getting a solution faster.

[wa1esy]

Yes of course. I haven't posted all 50000 lines but a brief selection. There are two tabs Before is how I get the data and after is how I want it to look.

I should also mention that this in on Excel 2007.

Thanks very much.

[lynnnow]

Sorry mate, I don't have Office 2007 installed here to help you. Someone else is going to have to give your problem a look.

[GTO]

Here is the OP's atachment as shown at #3, converted to .xls format.

[lynnnow]

GTO, I've got the file converter installed here, however, the coding may use options that have not used or tested and hence have thrown in the towel. Thanks.

[wa1esy]

Ah no probs. Thanks very much for having a crack at it.

Much appreciated.

[shrivallabha]

I saw this thread a little late. Sorry I could not work out the complete solution but here it is
[VBA]Sub SortAdd()
Dim LastRow As Long

LastRow = Sheets("Before").Range("I65536").End(xlUp).Row

With Sheets("Before")
For i = 2 To LastRow
If .Cells(i, 9) <> .Cells(i + 1, 9) Then
.Cells(i + 1, 10).Value = "Change"
End If
Next

End With
End Sub
[/VBA]
This inserts a value "Change" where the row needs to be inserted
Create a module and paste the code. Just insure that the worksheet name remains "Before" for time being.

I'm going on a leave so really could not go further. It was for the first time I could contribute to the forum where I am learning a lot.

I hope it gives you a stepping stone

[mbarron]

You can harness the power of Excel's built in Subtotal functionality.

Because of the coloring method being used, the macro would have to be altered to be used in Excel versions prior to 2007

[VBA] Sub subTots()
Range("a1").Subtotal groupby:=9, Function:=xlSum, totallist:= _
Array(2, 3, 4, 5, 6, 7, 8), summarybelowdata:=True
ActiveSheet.Outline.ShowLevels RowLevels:=2
With Range("A2", Cells.Find("*", searchDirection:=xlPrevious)).SpecialCells(xlCellTypeVisible)
With .Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight2
.TintAndShade = 0.399975585192419
.PatternTintAndShade = 0
End With
With .Font
.Bold = False
End With
End With

ActiveSheet.Outline.ShowLevels RowLevels:=3
Range("A2", Cells.SpecialCells(xlCellTypeLastCell)).Copy
Range("a2").PasteSpecial xlPasteValues
Rows(Cells.Find("*", searchDirection:=xlPrevious).Row).Delete
Range("A2").RemoveSubtotal
Range("I:I").Replace What:=" Total", Replacement:=""
End Sub[/VBA]

[wa1esy]

Oh my good god. It only bloody works!

mbarron, thank you so much. It seems to be working perfectly!

This forum rocks!

Thanks also to everyone else who responded to this. Keep up the good work.

[wa1esy]

Oh actually hold up on minute. There is one small issue that might actually be simple to resolve, I'm not sure, as I mentioned before I'm a VBA idiot.
Is there a way of leaving the highlighted cells as formulas so that when I review the data I can delete inappropriate rows and the sum will update automatically. Its just that sometimes not all of the names are actually the same, for example J Smith might pull in James Smith and John Smith, and I will need to delete the wrong ones.
Then I can just copy all, paste as values when I'm finished?

[mbarron]

Comment out the lines as shown below (the green ones). I've left them in the macro in case you want to revert to the original version.
[vba]Sub subTots()
Range("a1").Subtotal groupby:=9, Function:=xlSum, totallist:= _
Array(2, 3, 4, 5, 6, 7, 8), summarybelowdata:=True
ActiveSheet.Outline.ShowLevels RowLevels:=2
With Range("A2", Cells.Find("*", searchDirection:=xlPrevious)).SpecialCells(xlCellTypeVisible)
With .Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight2
.TintAndShade = 0.399975585192419
.PatternTintAndShade = 0
End With
With .Font
.Bold = False
End With
End With

ActiveSheet.Outline.ShowLevels RowLevels:=3
'Range("A2", Cells.SpecialCells(xlCellTypeLastCell)).Copy
'Range("a2").PasteSpecial xlPasteValues
Rows(Cells.Find("*", searchDirection:=xlPrevious).Row).Delete
'Range("A2").RemoveSubtotal
Range("I:I").Replace What:=" Total", Replacement:=""
End Sub[/vba]

[wa1esy]

That is absolutely perfect. Thanks so much.

Genius.