View Single Post
  #7   Report Post  
Posted to microsoft.public.excel.misc
ielmrani via OfficeKB.com ielmrani via OfficeKB.com is offline
external usenet poster
 
Posts: 24
Default How to group an excel sheet

Thanks Dave,
I only give you a sample of what I was trying to do. Now I am trying to
apply your code to a real sheet. I revised the code but it's not working.
Anytime I run the code it creates a new sheet, can it populate the data in an
existing sheet?
I tried to add new columns but they're not appearing in the sheet when I run
the code.

Please bear with me I am not an expert in excel, I am trying though. Thanks
so much.

Here is what I did so far:

Sub testme()

Dim CurWks As Worksheet
Dim RptWks As Worksheet
Dim iRow As Long
Dim oRow As Long
Dim FirstRow As Long
Dim LastRow As Long

Set CurWks = Worksheets("Sheet1")
Set RptWks = Worksheets.Add

With CurWks
FirstRow = 2
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
oRow = -1
For iRow = FirstRow To LastRow
If .Cells(iRow, "A").Value = .Cells(iRow - 1, "A").Value _
And .Cells(iRow, "B").Value = .Cells(iRow - 1, "B").Value Then

'same group, do nothing special
Else
'different group, do headers
oRow = oRow + 2
RptWks.Cells(oRow, "A").Value _
= "Owner: " & .Cells(iRow, "A").Value

oRow = oRow + 1
RptWks.Cells(oRow, "A").Value _
= "Beneficiary: " & .Cells(iRow, "A").Value

oRow = oRow + 2
RptWks.Cells(oRow, "A").Value = "Policy#"
RptWks.Cells(oRow, "B").Value = "Company"
RptWks.Cells(oRow, "C").Value = "Effective Date"
RptWks.Cells(oRow, "D").Value = "Face Amount"
RptWks.Cells(oRow, "E").Value = "Cash Value"
RptWks.Cells(oRow, "C").Value = "Surrender Value"
RptWks.Cells(oRow, "C").Value = "Annual Premium"
RptWks.Cells(oRow, "C").Value = "Policy Type"

End If

'do the policy stuff
oRow = oRow + 1
RptWks.Cells(oRow, "A").Value = "'" & .Cells(iRow, "C").Value
RptWks.Cells(oRow, "B").Value = "'" & .Cells(iRow, "D").Value
RptWks.Cells(oRow, "C").Value = "'" & .Cells(iRow, "E").Value
RptWks.Cells(oRow, "D").Value = "'" & .Cells(iRow, "F").Value
RptWks.Cells(oRow, "E").Value = "'" & .Cells(iRow, "G").Value
RptWks.Cells(oRow, "F").Value = "'" & .Cells(iRow, "H").Value
RptWks.Cells(oRow, "G").Value = "'" & .Cells(iRow, "I").Value
RptWks.Cells(oRow, "H").Value = "'" & .Cells(iRow, "J").Value
Next iRow
End With

End Sub



Dave Peterson wrote:
This actually belongs in a General module--not behind a worksheet.

You may want to read David McRitchie's intro at:
http://www.mvps.org/dmcritchie/excel/getstarted.htm

Dave,
This is amazing. It works. What I did is go to sheet I right click it and

[quoted text clipped - 16 lines]
Message posted via OfficeKB.com
http://www.officekb.com/Uwe/Forums.a...excel/200806/1



--
Message posted via OfficeKB.com
http://www.officekb.com/Uwe/Forums.a...excel/200806/1