HELP

[LilMoSweet]

I know I posted this question previously, but I need to know if this process
is possible.
If I have center names in the column and the data area contains amounts how
do I get the center names to appear on every row of the Pivot Table result.
Please help... Thanks

 

[JulieD]

Hi

Lil ... do you mean that you have

Center 1 Jan 50
Feb 50
Mar 50
Center 2 Jan 100
Feb 100
Mar 75

and you want
Center 1 Jan 50
Center 1 Feb 50
Center 1 Mar 50
Center 2 Jan 100
Center 2 Feb 100
Center 2 Mar 75

???
if so AFAIK it can't be done ...

best i could find was
Jan 50
Center 1 Feb 50
Mar 50
Jan 100
Center 2 Feb 100
Mar 75

if this is OK then right mouse click on the pivot table, choose table
options , tick merge labels.

Cheers
JulieD

 

[LilMoSweet]

Thank you - that is exactly what I was trying to do today and now I can tell
the manager that this process cannot be done.

 

[JulieD]

i've done a quick google search and found the following post from Dave
Ramage
--
The best way I've found to get the format you
want is to copy the pivot table, then do a Paste Special-
Values onto another sheet, and then run this macro which
will fill in the missing lines:

Sub IntelliFill()
'D Ramage, Jan 2000
'Fills empty cells with previous value
'Instructions: Select range (multiple columns are
allowed), then run
Dim rngR, rngCol As Range
Dim lCell, lEndSectionRow, lFirstRow, lLastRow,
lLastrngColCell As Long

On Error GoTo TheEnd
Application.ScreenUpdating = False
Application.Calculation = xlManual

If TypeName(Selection) <> "Range" Then Exit Sub
Set rngR = Selection
lFirstRow = rngR.Cells(1).Row
lLastRow = rngR.Columns(1).Cells(rngR.Columns
(1).Cells.Count).Row
lLastrngColCell = rngR.Columns(1).Cells.Count

For Each rngCol In rngR.Columns
lCell = 1
Do While rngCol.Cells(lCell + 1).Value <> "" And lCell
< lLastrngColCell
lCell = lCell + 1
Loop

Do While lCell < lLastrngColCell
lEndSectionRow = rngCol.Cells(lCell).End
(xlDown).Offset(-1, 0).Row
If lEndSectionRow > lLastRow Then lEndSectionRow =
lLastRow

Range(rngCol.Cells(lCell + 1), rngCol.Cells
(lEndSectionRow - lFirstRow + 1)).Value = _
rngCol.Cells(lCell).Value
lCell = lEndSectionRow + 2 - lFirstRow
Do While rngCol.Cells(lCell + 1).Value <> "" And
lCell < lLastrngColCell
lCell = lCell + 1
Loop
Loop
Next rngCol

TheEnd:
On Error GoTo 0

Application.ScreenUpdating = False
Application.Calculation = xlAutomatic

End Sub

---
might work for you. also there's code at
http://www.contextures.com/xlDataEntry02.html but i've not compared it to
the above code.

Cheers
JulieD

 

[Max]

i've done a quick google search and
found the following post from Dave Ramage

Julie, it's a pleasant reminder of Dave Ramage's post
to a past query of mine about 3 years ago <g>

Debra D had also suggested a shorter Sub FillBlanks() then ..

Sub FillBlanks()
'fill blanks cells with data from above
Range("A1").CurrentRegion _
.SpecialCells(xlCellTypeBlanks) _
.FormulaR1C1 = "=R[-1]C"
Range("A1").CurrentRegion.Copy
Range("A1").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End Sub

but think this sub of Debra's has been updated since
on her (Debra's) page with yet another by Dave Peterson:

Sub FillColBlanks()
'by Dave Peterson 2004-01-06
'fill blank cells in column with value above
Dim wks As Worksheet
Dim rng As Range
Dim LastRow As Long
Dim col As Long

Set wks = ActiveSheet
With wks
col = activecell.column
'or
'col = .range("b1").column

Set rng = .UsedRange 'try to reset the lastcell
LastRow = .Cells.SpecialCells(xlCellTypeLastCell).Row
Set rng = Nothing
On Error Resume Next
Set rng = .Range(.Cells(2, col), .Cells(LastRow, col)) _
.Cells.SpecialCells(xlCellTypeBlanks)
On Error GoTo 0

If rng Is Nothing Then
MsgBox "No blanks found"
Exit Sub
Else
rng.FormulaR1C1 = "=R[-1]C"
End If

'replace formulas with values
With .Cells(1, col).EntireColumn
.Value = .Value
End With

End With

End Sub