PDA

View Full Version : Need to split sheets based on number of family members



rajkumar
05-04-2017, 07:35 AM
Hi ,

need help in splitting data to five worksheets, the main data contains list of family members for a civil supplies card.
the requirement is to keep HEAD_OF_THE_FAMILY_NAME to 1st sheet and move family member 1 to 2nd sheet and family member 2 to 3rd sheet and family member 3 to 4th sheet and so on. up to five sheets max. all sheets column heading should be same. so the data should start from 2nd row in each sheet.

can anyone help with some coding. i have posted an example with smaller data, actually my file is too big.19083

thanks in advance
raj

Bob Phillips
05-04-2017, 08:22 AM
Public Function FamilyBreakUp()
Const HEAD_COLUMN As String = "HEAD_OF_THE_FAMILY_NAME"
Dim this As Worksheet
Dim ptReport As Worksheet
Dim ws As Worksheet
Dim pt As PivotTable
Dim data As Range
Dim idxRow As Long
Dim i As Long, j As Long

Application.ScreenUpdating = False

Set ptReport = Worksheets.Add
ptReport.Name = "Pivot"
Set this = Worksheets("Data")
Set data = this.Range("A1").CurrentRegion

ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
SourceData:=data, _
Version:=xlPivotTableVersion10).CreatePivotTable _
TableDestination:=ptReport.Range("A3"), _
TableName:="ptFamily", _
DefaultVersion:=xlPivotTableVersion10
Set pt = ptReport.PivotTables("ptFamily")

idxRow = 1
With pt

.RepeatAllLabels xlRepeatLabels

For j = 1 To data.Columns.Count

If this.Cells(1, j).Value = HEAD_COLUMN Then

With .PivotFields("HEAD_OF_THE_FAMILY_NAME")

.Orientation = xlPageField
.Position = 1
End With
Else

With .PivotFields(this.Cells(1, j).Value)

.Orientation = xlRowField
.Position = idxRow

.Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)

idxRow = idxRow + 1
End With
End If
Next j

.ColumnGrand = False
.RowGrand = False

.ShowPages PageField:=HEAD_COLUMN
End With

For Each ws In ActiveWorkbook.Worksheets

If ws.Name <> "Data" And ws.Name <> "Pivot" Then

ws.Cells.Copy
ws.Cells.PasteSpecial Paste:=xlPasteValues

ws.Activate
Range("A1").Select
End If
Next ws

Application.DisplayAlerts = False
ptReport.Delete
Application.DisplayAlerts = True

Application.ScreenUpdating = True
End Function

mdmackillop
05-04-2017, 09:10 AM
Public Function FamilyBreakUp() :crying:

Bob Phillips
05-04-2017, 09:11 AM
I try to play to the crowds :devil2:

rajkumar
05-04-2017, 07:44 PM
HI thanks for your reply but, my requirement is different from what has come out here. let me explain with samples here. i have attached two workbooks here . one is source and another is output. i need to convert the source model to output model. please help.1908919090

thanks
raj

SamT
05-05-2017, 06:56 AM
Head Of Family, OR First Relative listed if Not Self, Shall be placed on Sheet "A".
The first relative listed shall be placed on Sheet "B". (The Next listed if the first is on Sheet "A")
The Second relative shall be on Sheet "C". and the third on "D", etc.
If the maximum number of relatives listed on the Source sheet is three, then this will require 4 Sheets. But if some Head of Family has ten relatives listed, this will require 11 sheets.

The Sheets should be considered more of a Relative Ranking system than a Family Relative system.