pivot table clear data in cells

[memory100]

have pivot table set up in report format with various fields from a CRM database.

I want to clear blank data in the cells when the user click in the pivot table cell to open a certain cell to view the data that is whtiin the pivot table. it creates a new sheet with all the data in but i only want it show the data the user wants to see as it shows me so many blank data fields!

here is screenshot of the pivot table:
http://img811.imageshack.us/img811/5184/69095741.jpg

new sheet that is created when the user click the pivit table cell they want to see:
http://img130.imageshack.us/img130/6124/united2yt.jpg

i have tried to use a macro to clear the cells in the new sheet the pivot tables creates but the data range can vary accoridng to the users selection of data from the pivot table is there any way to sort this out ?

here is the code for the macro i have used:

(Toggle Plain Text)
Sub Test()
With ActiveSheet.Range("A1:A5").CurrentRegion
.AutoFilter
.AutoFilter Field:=4, Criteria1:="="
.Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
.Parent.AutoFilterMode = False
End With
End SubSub Test()
With ActiveSheet.Range("A1:A5").CurrentRegion
.AutoFilter
.AutoFilter Field:=4, Criteria1:="="
.Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
.Parent.AutoFilterMode = False
End With
End Sub

could i use vb to solve this ? or is a macro best for this?

question is it possible to create a macro that can rid of these range of fields ? as the range will differ according to what cell the user opens in the pivot table as the data us pulled and refreshed from the datasource.

[AndreRet]

Have a look at the following and choose the sub that will best represent your scenario -

Sub DeleteBlankRows1()

'Deletes the entire row within the selection if the ENTIRE row contains no data.



'We use Long in case they have over 32,767 rows selected.

Dim i As Long 



	'We turn off calculation and screenupdating to speed up the macro.

	With Application

		.Calculation = xlCalculationManual

		.ScreenUpdating = False

      

	'We work backwards because we are deleting rows.

	For i = Selection.Rows.Count To 1 Step -1

		If WorksheetFunction.CountA(Selection.Rows(i)) = 0 Then

			Selection.Rows(i).EntireRow.Delete

		End If

	Next i



		.Calculation = xlCalculationAutomatic

		.ScreenUpdating = True

 	End With

End Sub
Sub DeleteBlankRows2()

'Deletes the entire row within the selection if _

 some of the cells WITHIN THE SELECTION contain no data.

On Error Resume Next

Selection.EntireRow.SpecialCells(xlBlanks).EntireRow.Delete

On Error GoTo 0

End Sub
Sub DeleteBlankRows3()

'Deletes the entire row within the selection if _

the ENTIRE row contains no data.



Dim Rw As Range

If WorksheetFunction.CountA(Selection) = 0 Then

   MsgBox "No data found", vbOKOnly, "OzGrid.com"

   Exit Sub

End If

    With Application

        .Calculation = xlCalculationManual

        .ScreenUpdating = False



    Selection.SpecialCells(xlCellTypeBlanks).Select



        For Each Rw In Selection.Rows

            If WorksheetFunction.CountA(Selection.EntireRow) = 0 Then

                Selection.EntireRow.Delete

            End If

        Next Rw



        .Calculation = xlCalculationAutomatic

        .ScreenUpdating = True

    End With

End Sub
Sub MoveBlankRowsToBottom()

'Assumes the list has a heading



	With Selection

		.Sort Key1:=.Cells(2, 1), Order1:=xlAscending, _

			Header:=xlYes, OrderCustom:=1, MatchCase:=False, _

			Orientation:=xlTopToBottom

	End With 

End Sub
Sub DeleteRowsBasedOnCriteria()

'Assumes the list has a heading.

   	With ActiveSheet

             If .AutoFilterMode = False Then .Cells(1, 1).AutoFilter

                    .Range("A1").AutoFilter Field:=1, Criteria1:="Delete"

                    .Range("A1").CurrentRegion.Offset(1, 0).SpecialCells _

			(xlCellTypeVisible).EntireRow.Delete

     		.AutoFilterMode = False

	End With

End Sub
Sub DeleteRowsWithSpecifiedData()

'Looks in Column D and requires Column IV to be clean

	Columns(4).EntireColumn.Insert



	With Range("D1:D" & ActiveSheet.UsedRange.Rows.Count)

 			.FormulaR1C1 = "=IF(RC[1]="""","""",IF(RC[1]=""Not Needed"",NA()))"

			.Value = .Value

			On Error Resume Next

			.SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.Delete

	End With

	On Error GoTo 0

	Columns(4).EntireColumn.Delete

End Sub

To use any or all of the above code:

Open Excel.
Push Alt+F11 to open the VBE (Visual Basic Editor).
Go to Insert>Module.
Copy the code and paste it in the new module.
Push Alt+Q to return to Excels normal view.
Push Alt+F8 and then select the macro name and click Run. Or select Options and assign a shortcut key.

Removing Blank Rows Automatically

The codes above will work fine for removing blank rows from a list that already has some, but as the saying goes "Prevention is better than cure". The two examples below will remove blank rows as they occur. Either code should be placed within the Worksheet module and will occur each time a cell changes on the worksheet.

In both codes you will notice the Application.EnableEvents=False this is often needed within Event codes like this, else the Event will be triggered again once the code executes which in turn will again trigger the Event and so on.....

You will no doubt also notice the GoTo SelectionCode which occurs if the number of cells within the selection exceeds one. The reason for this is an error would occur if the code reached the Target keyword as Target refers to a single cell.

The second example uses the Sort method rather than the EntireRow.Delete and is the preferred method to use if possible. What happens is, any blank rows are placed at the bottom of the range should the entire row be blank.

The use of the keyword Me is a good habit to get into when working within Worksheet and Workbook modules.

Private Sub Worksheet_Change(ByVal Target As Range)

'Deletes blank rows as they occur.



	'Prevent endless loops

	Application.EnableEvents = False

	'They have more than one cell selected

	If Target.Cells.Count > 1 Then GoTo SelectionCode

		If WorksheetFunction.CountA(Target.EntireRow) = 0 Then

			Target.EntireRow.Delete

		End If



	Application.EnableEvents = True

	'Our code will only enter here if the selection is more than one cell.

	Exit Sub

			

SelectionCode:

	If WorksheetFunction.CountA(Selection.EntireRow) = 0 Then

		Selection.EntireRow.Delete

	End If

	Application.EnableEvents = True

End Sub
Private Sub Worksheet_Change(ByVal Target As Excel.Range)

'Sorts blank rows to the bottom as they occur



	'Prevents endless loops

	Application.EnableEvents = False

	'They have more than one cell selected

		If Target.Cells.Count > 1 Then GoTo SelectionCode

			If WorksheetFunction.CountA(Target.EntireRow) <> 0 Then

				Me.UsedRange.Sort Key1:=[A2], Order1:=xlAscending, _

					Header:=xlYes, OrderCustom:=1, MatchCase:=False, _

					Orientation:=xlTopToBottom



		End If

	Application.EnableEvents = True



Exit Sub 'Our code will only enter here if the selection is _

more than one cell.



SelectionCode:

	If WorksheetFunction.CountA(Selection.EntireRow) = 0 Then

		Me.UsedRange.Sort Key1:=[A2], Order1:=xlAscending, _

			Header:=xlYes, OrderCustom:=1, MatchCase:=False, _

			Orientation:=xlTopToBottom

	End If

	Application.EnableEvents = True

End Sub

To use either one of the above codes:

Open Excel.
Right click on the Sheet name tab.
Select View Code from the Pop-up menu
Copy the code and paste it over the top of the default Event
Push Alt+Q to return to Excels normal view.
Push Alt+F8 and then select the macro name and click Run. Or select Options and assign a shortcut key.

Of all the examples above that use Excels AutoFilters and Sort are by far the quickest methods I know of.:)

[memory100]

I paste the snd code into a new module but it does not show up as macro in excel! any ideas why ?
here is a screenshot:
http://img269.imageshack.us/img269/271/codedl.jpg
i have tried ths first code it dows not delete the rows i want.
here is attachment of the pivit data i am dealing with.!