Is it possible to add 2 blank columns next to pivot table

[Jagdev Singh]

Hi Experts

I am aware that we can add columns manually after the pivot table. Is it possible to automate this process via VBA. I have many files in which I have to perform same exercise every time. The last column in the Pivot table is currency one and it varies in most of the case. What I am looking for is after the pivot result I want 2 column names to be added next to pivot table with data validation option in it. Please let me know if this is possible or not.

Regards,

 

[Luke M]

Here's a short example to get you started.

Sub AddLabels()
Dim lastCell As Range

'Assumes PivotTable header is in row 4
With ActiveSheet
    Set lastCell = .Cells(4, .Columns.Count).End(xlToLeft)
   
    'Add new labels
    lastCell.Offset(0, 1).Value = "Column 1"
    lastCell.Offset(0, 2).Value = "Column 2"
End With
End Sub

 

[Jagdev Singh]

Hi Luke,

Thanks for the above code it works like a charm. This covers my first requirement. I have to assign validation list to column header “Column1”. I recorded the macro and below is the code. What the code does is selecting the entire cells in the column. Please help me to set the dynamic range and assign it to the code so that the validation available only to the list of data available in the sheet.

Cells.Find(What:="Column 1", After:=Cells(4, 2), LookIn:=xlValues, LookAt _
        :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    ActiveCell.Offset(1, 0).Select
    Range(Selection, Selection.End(xlDown)).Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="Agreed – Already Paid,Agreed - Collected from assured,Agreed - Uncollected from assured,Not Agreed - Billing Difference,Not Agreed - Unbilled,Agreed - Credit,Agreed – Ready to be Paid"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With

Regards,
JD

 

[Luke M]

Hi JD,

Here's how I would make the above code more dynamic. Let me know if it makes sense?

Dim fCell As Range
Dim lastRow As Long

'Find the cell of interest
Set fCell = Cells.Find(What:="Column 1", After:=Range("A1"), LookIn:=xlValues, LookAt _
        :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False)
       
'Find the last row
lastRow = Cells(Rows.Count, "A").End(xlUp).Row

With Range(fCell.Offset(1), Cells(lastRow, fCell.Column)).Validation
    .Delete
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
    xlBetween, Formula1:="Agreed – Already Paid,Agreed - Collected from assured,Agreed - Uncollected from assured,Not Agreed - Billing Difference,Not Agreed - Unbilled,Agreed - Credit,Agreed – Ready to be Paid"
    .IgnoreBlank = True
    .InCellDropdown = True
    .InputTitle = ""
    .ErrorTitle = ""
    .InputMessage = ""
    .ErrorMessage = ""
    .ShowInput = True
    .ShowError = True
End With

 

[Jagdev Singh]

Hi Luke,

You are a savior. Thanks for the above code.

Regards,
JD