Help with macro to copy and past pivot tables based on various criteria

Tritritri

New Member
Joined
Jan 6, 2014
Messages
5
Hello,
I am brand new to VB and have run into a roadblock in writing a macro that will achieve my desired result. I apologize for any lack of clarity due to my unfamiliarity with this. I am using excel 2010

Users will answer 'yes' or 'no' to 8 different questions. If the answer is 'no' I would like for the corresponding pivot table to appear in specified locations (there is a separate pivot for each question, 8 total). The locations are B33, D33, F33 and H33. I would only like the pivot tables for the first 4 'no’s' to appear.
Examples of possible results:</SPAN>
No-1</SPAN>
No-2</SPAN>
No-3</SPAN>
No-4</SPAN>
Pivot-1</SPAN>
Pivot-2</SPAN>
Pivot-5</SPAN>
Pivot-6</SPAN>

<TBODY>
</TBODY>
-OR-
No-1</SPAN>
No-2</SPAN>
No-3</SPAN>
No-4</SPAN>
P-3</SPAN>
P-4</SPAN>
P-7</SPAN>
P-8</SPAN>

<TBODY>
</TBODY>
I have recorded macros of copy and pasting the various options for specified pivot table locations. I have then tried to create a IF_ElseIf_Else macro to automate the action. Below is the code I have so far. Any help that can be offered is much appreciated. If there is an easier way to make this happen, that would be great too!
Thanks,
Luke </SPAN>
Sub IF_ELSEIF_ELSE_FUNCTION()
If Worksheets("Calcs").Range("D19").Formula = Worksheets("Calcs").Range("A14") Then
Sub CoachesD_1()
'
' CoachesD_1 Macro
'
'
Sheets("Pivots").Select
Range("A2:A4").Select
Selection.Copy
Sheets("Career Path and Dev. Plan").Select
Range("B33").Select
ActiveSheet.Paste
End Sub
ElseIf Worksheets("Calcs").Range("D20") = Worksheets("Calcs").Range("A15") Then
Sub LeadsD_1()
'
' LeadsD_1 Macro
'
'
Sheets("Pivots").Select
Range("B2:B3").Select
Selection.Copy
Sheets("Career Path and Dev. Plan").Select
Range("B33").Select
ActiveSheet.Paste
End Sub
ElseIf Worksheets("Calcs").Range("D21") = Worksheets("Calcs").Range("A16") Then
Sub AchievesD_1()
'
' AchievesD_1 Macro
'
'
Sheets("Pivots").Select
Range("C2:C4").Select
Selection.Copy
Sheets("Career Path and Dev. Plan").Select
Range("B33").Select
ActiveSheet.Paste
End Sub
ElseIf Worksheets("Calcs").Range("D22") = Worksheets("Calcs").Range("A17") Then
Sub CommunicatesD_1()
'
' CommunicatesD_1 Macro
'
'
Sheets("Pivots").Select
Range("D2:D3").Select
Selection.Copy
Sheets("Career Path and Dev. Plan").Select
Range("B33").Select
ActiveSheet.Paste
End Sub
ElseIf Worksheets("Calcs").Range("D23") = Worksheets("Calcs").Range("F14") Then
Sub PutsD_1()
'
' PutsD_1 Macro
'
'
Sheets("Pivots").Select
Range("E2:E3").Select
Selection.Copy
Sheets("Career Path and Dev. Plan").Select
Range("B33").Select
ActiveSheet.Paste
End Sub
ElseIf Worksheets("Calcs").Range("D24") = Worksheets("Calcs").Range("F15") Then
Sub ProvidesD_1()
'
' ProvidesD_1 Macro
'
'
Sheets("Pivots").Select
Range("F2:F3").Select
Selection.Copy
Sheets("Career Path and Dev. Plan").Select
Range("B33").Select
ActiveSheet.Paste
End Sub
ElseIf Worksheets("Calcs").Range("D25") = Worksheets("Calcs").Range("F16") Then
Sub ExecutesD_1()
'
' ExecutesD_1 Macro
'
'
Sheets("Pivots").Select
Range("G2:G3").Select
Selection.Copy
Sheets("Career Path and Dev. Plan").Select
Range("B33").Select
ActiveSheet.Paste
End Sub
ElseIf Worksheets("Calcs").Range("D26") = Worksheets("Calcs").Range("F17") Then
Sub ChangeD_1()
'
' ChangeD_1 Macro
'
'
Sheets("Pivots").Select
Range("H2:H4").Select
Selection.Copy
Sheets("Career Path and Dev. Plan").Select
Range("B33").Select
ActiveSheet.Paste
End Sub
ElseIf Worksheets("Calcs").Range("D28") = Worksheets("Calcs").Range("A15") Then
Sub LeadsD_2()
'
' LeadsD_2 Macro
'
'
Sheets("Pivots").Select
Range("B2:B3").Select
Selection.Copy
Sheets("Career Path and Dev. Plan").Select
Range("D33").Select
ActiveSheet.Paste
End Sub
ElseIf Worksheets("Calcs").Range("D29") = Worksheets("Calcs").Range("A16") Then
Sub AchievesD_2()
'
' AchievesD_2 Macro
'
'
Sheets("Pivots").Select
Range("C2:C4").Select
Selection.Copy
Sheets("Career Path and Dev. Plan").Select
Range("D33").Select
ActiveSheet.Paste
End Sub
ElseIf Worksheets("Calcs").Range("D30") = Worksheets("Calcs").Range("A17") Then
Sub CommunicatesD_2()
'
' CommunicatesD_2 Macro
'
'
Sheets("Pivots").Select
Range("D2:D3").Select
Selection.Copy
Sheets("Career Path and Dev. Plan").Select
Range("D33").Select
ActiveSheet.Paste
End Sub
ElseIf Worksheets("Calcs").Range("D31") = Worksheets("Calcs").Range("F14") Then
Sub PutsD_2()
'
' PutsD_2 Macro
'
'
Sheets("Pivots").Select
Range("E2:E3").Select
Selection.Copy
Sheets("Career Path and Dev. Plan").Select
Range("D33").Select
ActiveSheet.Paste
End Sub
ElseIf Worksheets("Calcs").Range("D32") = Worksheets("Calcs").Range("F15") Then
Sub ProvideD_2()
'
' ProvideD_2 Macro
'
'
Sheets("Pivots").Select
Range("F2:F3").Select
Selection.Copy
Sheets("Career Path and Dev. Plan").Select
Range("D33").Select
ActiveSheet.Paste
End Sub
ElseIf Worksheets("Calcs").Range("D33") = Worksheets("Calcs").Range("F16") Then
Sub ExecutesD_2()
'
' ExecutesD_2 Macro
'
'
Sheets("Pivots").Select
Range("G2:G3").Select
Selection.Copy
Sheets("Career Path and Dev. Plan").Select
Range("D33").Select
ActiveSheet.Paste
End Sub
ElseIf Worksheets("Calcs").Range("D34") = Worksheets("Calcs").Range("F17") Then
Sub ChangeD_2()
'
' ChangeD_2 Macro
'
'
Sheets("Pivots").Select
Range("H2:H4").Select
Selection.Copy
Sheets("Career Path and Dev. Plan").Select
Range("D33").Select
ActiveSheet.Paste
End Sub
ElseIf Worksheets("Calcs").Range("D37") = Worksheets("Calcs").Range("A16") Then
Sub AchievesD_3()
'
' AchievesD_3 Macro
'
'
Sheets("Pivots").Select
Range("C2:C4").Select
Selection.Copy
Sheets("Career Path and Dev. Plan").Select
Range("F33").Select
ActiveSheet.Paste
End Sub
ElseIf Worksheets("Calcs").Range("D38") = Worksheets("Calcs").Range("A17") Then
Sub CommunicatesD_3()
'
' CommunicatesD_3 Macro
'
'
Sheets("Pivots").Select
Range("D2:D4").Select
Selection.Copy
Sheets("Career Path and Dev. Plan").Select
Range("F33").Select
ActiveSheet.Paste
End Sub
ElseIf Worksheets("Calcs").Range("D39") = Worksheets("Calcs").Range("F14") Then
Sub PutsD_3()
'
' PutsD_3 Macro
'
'
Sheets("Pivots").Select
Range("E2:E4").Select
Selection.Copy
Sheets("Career Path and Dev. Plan").Select
Range("F33").Select
ActiveSheet.Paste
End Sub
ElseIf Worksheets("Calcs").Range("D40") = Worksheets("Calcs").Range("F15") Then
Sub ProvideD_3()
'
' ProvideD_3 Macro
'
'
Sheets("Pivots").Select
Range("F2:F4").Select
Selection.Copy
Sheets("Career Path and Dev. Plan").Select
Range("F33").Select
ActiveSheet.Paste
End Sub
ElseIf Worksheets("Calcs").Range("D41") = Worksheets("Calcs").Range("F16") Then
Sub ExecutesD_3()
'
' ExecutesD_3 Macro
'
'
Sheets("Pivots").Select
Range("G2:G4").Select
Selection.Copy
Sheets("Career Path and Dev. Plan").Select
Range("F33").Select
ActiveSheet.Paste
End Sub
ElseIf Worksheets("Calcs").Range("D42") = Worksheets("Calcs").Range("F17") Then
Sub ChangeD_3()
'
' ChangeD_3 Macro
'
'
Sheets("Pivots").Select
Range("H2:H4").Select
Selection.Copy
Sheets("Career Path and Dev. Plan").Select
Range("F33").Select
ActiveSheet.Paste
End Sub
ElseIf Worksheets("Calcs").Range("D46") = Worksheets("Calcs").Range("A17") Then
Sub CommunicatesD_4()
'
' CommunicatesD_4 Macro
'
'
Sheets("Pivots").Select
Range("D2:D4").Select
Selection.Copy
Sheets("Career Path and Dev. Plan").Select
Range("H33").Select
ActiveSheet.Paste
End Sub
ElseIf Worksheets("Calcs").Range("D47") = Worksheets("Calcs").Range("F14") Then
Sub PutsD_4()
'
' PutsD_4 Macro
'
'
Sheets("Pivots").Select
Range("E2:E4").Select
Selection.Copy
Sheets("Career Path and Dev. Plan").Select
Range("H33").Select
ActiveSheet.Paste
End Sub
ElseIf Worksheets("Calcs").Range("D48") = Worksheets("Calcs").Range("F15") Then
Sub ProvideD_4()
'
' ProvideD_4 Macro
'
'
Sheets("Pivots").Select
Range("F2:F4").Select
Selection.Copy
Sheets("Career Path and Dev. Plan").Select
Range("H33").Select
ActiveSheet.Paste
End Sub
ElseIf Worksheets("Calcs").Range("D49") = Worksheets("Calcs").Range("F16") Then
Sub ExecutesD_4()
'
' ExecutesD_4 Macro
'
'
Sheets("Pivots").Select
Range("G2:G4").Select
Selection.Copy
Sheets("Career Path and Dev. Plan").Select
Range("H33").Select
ActiveSheet.Paste
End Sub
ElseIf Worksheets("Calcs").Range("D50") = Worksheets("Calcs").Range("F17") Then
Sub ChangeD_4()
'
' ChangeD_4 Macro
'
'
Sheets("Pivots").Select
Range("H2:H4").Select
Selection.Copy
Sheets("Career Path and Dev. Plan").Select
Range("H33").Select
ActiveSheet.Paste
End Sub

<TBODY>
</TBODY>
 

Excel Facts

Convert text numbers to real numbers
Select a column containing text numbers. Press Alt+D E F to quickly convert text to numbers. Faster than "Convert to Number"

Jerry Sullivan

MrExcel MVP
Joined
Mar 18, 2010
Messages
8,787
Hi Luke and Welcome to MrExcel,

If your PivotTable's share the same data source, it might be simpler just to have the 4 PivotTables in place, and use the users' responses to the questions to trigger changes the PivotTable's filters or fields displayed.

If you opt to pursue the approach of copying PivotTables, the code to do that could definitely be simplified from what you are trying now. I'd be glad to help you with either approach.
 

Tritritri

New Member
Joined
Jan 6, 2014
Messages
5
Jerry-

Thank you for the welcome and the information! Each pivot table gets its data from a source that is unique to that question. If you could help simplify my code, that would be great!


Thank you for your help!
Luke
 

Jerry Sullivan

MrExcel MVP
Joined
Mar 18, 2010
Messages
8,787
Please explain how you want the user to enter the responses to the questions and how those responses determine the source and destination for copying the pivots.
 

Tritritri

New Member
Joined
Jan 6, 2014
Messages
5

ADVERTISEMENT

Jerry-

Thanks again for the help. The big picture of this sheet is to have 2 (visible) tabs: 1st tab is a place where user inputs information (or selects from drop-downs) and 2nd tab will be a summary of the inputed information with the addition of specific data (pivots) bease on how the user evaluates 8 behaviors.

All 8 behaviors will be answered using a drop-down. The first 4 will be scored either "effective" or "ineffective" and the next 4 will be scored "Exceeds expectation," "Meets expectation" and "Does not meet expectation."

The behaviors that are "ineffective" or "Deos not meet expectation," will be the indicator of the pivots that will be used.

I have an IF formula that indicates the first four behaviors that will need a pivot table (1 behavior per area). This formula can probably be simplified as well, but I'm not sure how. To answer your question, I do not know how to specify, based on the areas the behaviors appear, where they will need to go. Here is that table that shows the first 4 behaviors based on the users responses to the 8 behaviors.

Development Areas</SPAN></SPAN>

1</SPAN></SPAN>
=IF(B$14 = A$4,A$14,FALSE)</SPAN></SPAN>
2</SPAN></SPAN>
=IF(D19=FALSE,IF(B$15=A$4,A$15,FALSE),FALSE)</SPAN></SPAN>
3</SPAN></SPAN>
=IF(D20=FALSE,IF(D19=FALSE, IF(B$16=A$4,A$16, FALSE), FALSE),FALSE)</SPAN></SPAN>
4</SPAN></SPAN>
=IF(D21=FALSE,IF(D20=FALSE, IF(D$19=FALSE, IF(B$17=A$4,A$17, FALSE), FALSE),FALSE),FALSE)</SPAN></SPAN>
5</SPAN></SPAN>
=IF(D22=FALSE,IF(D21=FALSE,IF(D20=FALSE,IF(D19=FALSE,IF(H$14=C$3,F$14,FALSE),FALSE),FALSE),FALSE),FALSE)</SPAN></SPAN>
6</SPAN></SPAN>
=IF(D23=FALSE,IF(D22=FALSE,IF(D21=FALSE,IF(D20=FALSE,IF(D19=FALSE,IF(H$15=C$3,F$15,FALSE),FALSE),FALSE),FALSE), FALSE),FALSE)</SPAN></SPAN>
7</SPAN></SPAN>
=IF(D24=FALSE,IF(D23=FALSE,IF(D22=FALSE,IF(D21=FALSE,IF(D20=FALSE,IF(D19=FALSE,IF(H$16=C$3,F$16,FALSE),FALSE),FALSE),FALSE), FALSE),FALSE),FALSE)</SPAN></SPAN>
8</SPAN></SPAN>
=IF(D25=FALSE,IF(D24=FALSE,IF(D23=FALSE,IF(D22=FALSE,IF(D21=FALSE,IF(D20=FALSE,IF(D19=FALSE,IF(H$17=C$3,F$17,FALSE),FALSE),FALSE),FALSE), FALSE),FALSE),FALSE),FALSE)</SPAN></SPAN>
9</SPAN></SPAN>
=IF(B$14 = A$4,FALSE,FALSE)</SPAN></SPAN>
10</SPAN></SPAN>
=IF(D20=FALSE,IF(D27=FALSE,IF(B$15=A$4,A$15,FALSE),FALSE),FALSE)</SPAN></SPAN>
11</SPAN></SPAN>
=IF(D21=FALSE,IF(D28=FALSE,IF(D27=FALSE, IF(B$16=A$4,A$16, FALSE), FALSE),FALSE), FALSE)</SPAN></SPAN>
12</SPAN></SPAN>
=IF(D22=FALSE,IF(D29=FALSE,IF(D28=FALSE, IF(D27=FALSE, IF(B$17=A$4,A$17, FALSE), FALSE),FALSE),FALSE), FALSE)</SPAN></SPAN>
13</SPAN></SPAN>
=IF(D23=FALSE,IF(D22=FALSE,IF(D21=FALSE,IF(D20=FALSE,IF(D19=FALSE,IF(H$14=C$3,F$14,FALSE),FALSE),FALSE),FALSE),FALSE), FALSE)</SPAN></SPAN>
14</SPAN></SPAN>
=IF(D24=FALSE,IF(D31=FALSE,IF(D30=FALSE,IF(D29=FALSE,IF(D28=FALSE,IF(D27=FALSE,IF(H$15=C$3,F$15,FALSE),FALSE),FALSE),FALSE), FALSE),FALSE), FALSE)</SPAN></SPAN>
15</SPAN></SPAN>
=IF(D25=FALSE,IF(D32=FALSE,IF(D31=FALSE,IF(D30=FALSE,IF(D29=FALSE,IF(D28=FALSE,IF(D27=FALSE,IF(H$16=C$3,F$16,FALSE),FALSE),FALSE),FALSE), FALSE),FALSE),FALSE), FALSE)</SPAN></SPAN>
16</SPAN></SPAN>
=IF(D26=FALSE,IF(D33=FALSE,IF(D32=FALSE,IF(D31=FALSE,IF(D30=FALSE,IF(D29=FALSE,IF(D28=FALSE,IF(D27=FALSE,IF(H$17=C$3,F$17,FALSE),FALSE),FALSE),FALSE), FALSE),FALSE),FALSE),FALSE),FALSE)</SPAN></SPAN>
17</SPAN></SPAN>
=IF(B$14 = A$4,FALSE,FALSE)</SPAN></SPAN>
18</SPAN></SPAN>
=IF(D28=FALSE, FALSE, FALSE)</SPAN></SPAN>
19</SPAN></SPAN>
=IF(D21=FALSE,IF(D29=FALSE,IF(D36=FALSE,IF(D35=FALSE, IF(B$16=A$4,A$16, FALSE), FALSE),FALSE), FALSE),FALSE)</SPAN></SPAN>
20</SPAN></SPAN>
=IF(D22=FALSE,IF(D30=FALSE,IF(D37=FALSE,IF(D36=FALSE, IF(D35=FALSE, IF(B$17=A$4,A$17, FALSE), FALSE),FALSE),FALSE), FALSE), FALSE)</SPAN></SPAN>
21</SPAN></SPAN>
=IF(D31=FALSE,IF(D23=FALSE,IF(D22=FALSE,IF(D21=FALSE,IF(D20=FALSE,IF(D19=FALSE,IF(H$14=C$3,F$14,FALSE),FALSE),FALSE),FALSE),FALSE), FALSE), FALSE)</SPAN></SPAN>
22</SPAN></SPAN>
=IF(D24=FALSE,IF(D32=FALSE,IF(D39=FALSE,IF(D38=FALSE,IF(D37=FALSE,IF(D36=FALSE,IF(D35=FALSE,IF(H$15=C$3,F$15,FALSE),FALSE),FALSE),FALSE), FALSE),FALSE), FALSE), FALSE)</SPAN></SPAN>
23</SPAN></SPAN>
=IF(D25=FALSE,IF(D33=FALSE,IF(D40=FALSE,IF(D39=FALSE,IF(D38=FALSE,IF(D37=FALSE,IF(D36=FALSE,IF(D35=FALSE,IF(H$16=C$3,F$16,FALSE),FALSE),FALSE),FALSE), FALSE),FALSE),FALSE), FALSE), FALSE)</SPAN></SPAN>
24</SPAN></SPAN>
=IF(D26=FALSE,IF(D34=FALSE,IF(D41=FALSE,IF(D40=FALSE,IF(D39=FALSE,IF(D38=FALSE,IF(D37=FALSE,IF(D36=FALSE,IF(D35=FALSE,IF(H$17=C$3,F$17,FALSE),FALSE),FALSE),FALSE), FALSE),FALSE),FALSE),FALSE),FALSE), FALSE)</SPAN></SPAN>
25</SPAN></SPAN>
=IF(D19=FALSE,IF(D27=FALSE,IF(D35=FALSE,IF(B$14=A$4,A$14, FALSE), FALSE),FALSE), FALSE)</SPAN></SPAN>
26</SPAN></SPAN>
=IF(D20=FALSE,IF(D28=FALSE,IF(D36=FALSE,IF(D43=FALSE,IF(B$15=A$4,A$15, FALSE), FALSE),FALSE), FALSE), FALSE)</SPAN></SPAN>
27</SPAN></SPAN>
=IF(D21=FALSE,IF(D29=FALSE,IF(D37=FALSE,IF(D44=FALSE,IF(D43=FALSE, IF(B$16=A$4,A$16, FALSE), FALSE),FALSE), FALSE), FALSE), FALSE)</SPAN></SPAN>
28</SPAN></SPAN>
=IF(D22=FALSE,IF(D30=FALSE, IF(D38=FALSE,IF(D45=FALSE,IF(D44=FALSE, IF(D43=FALSE, IF(B$17=A$4,A$17, FALSE), FALSE),FALSE),FALSE), FALSE), FALSE), FALSE)</SPAN></SPAN>
29</SPAN></SPAN>
=IF(D39=FALSE,IF(D31=FALSE,IF(D23=FALSE,IF(D22=FALSE,IF(D21=FALSE,IF(D20=FALSE,IF(D19=FALSE,IF(H$14=C$3,F$14,FALSE),FALSE),FALSE),FALSE),FALSE), FALSE), FALSE), FALSE)</SPAN></SPAN>
30</SPAN></SPAN>
=IF(D24=FALSE,IF(D32=FALSE,IF(D40=FALSE,IF(D47=FALSE,IF(D46=FALSE,IF(D45=FALSE,IF(D44=FALSE,IF(D43=FALSE,IF(H$15=C$3,F$15,FALSE),FALSE),FALSE),FALSE), FALSE),FALSE), FALSE), FALSE), FALSE)</SPAN></SPAN>
31</SPAN></SPAN>
=IF(D25=FALSE,IF(D33=FALSE,IF(D41=FALSE,IF(D48=FALSE,IF(D47=FALSE,IF(D46=FALSE,IF(D45=FALSE,IF(D44=FALSE,IF(D43=FALSE,IF(H$16=C$3,F$16,FALSE),FALSE),FALSE),FALSE), FALSE),FALSE),FALSE), FALSE), FALSE), FALSE)</SPAN></SPAN>
32</SPAN></SPAN>
=IF(D26=FALSE,IF(D34=FALSE,IF(D42=FALSE,IF(D49=FALSE,IF(D48=FALSE,IF(D47=FALSE,IF(D46=FALSE,IF(D45=FALSE,IF(D44=FALSE,IF(D43=FALSE,IF(H$17=C$3,F$17,FALSE),FALSE),FALSE),FALSE), FALSE),FALSE),FALSE),FALSE),FALSE), FALSE), FALSE)</SPAN></SPAN>

<TBODY>
</TBODY>


Area 1=1-8, Area 2=9-16, Area 3=17-24 Area 4=25-32 (1 behavior per area)

The references for the 8 behaviors cells are: 1=A14, 2=A15, 3=A16, 4=A17 and 5=H14, 6=H15, 7=H16, 8=H17.
The above table and the behavior references are on worksheet "Calcs"

The pivot tables are on worksheet "Pivots" 1=A2:A4, 2=B 3=C, etc...

The cells of the desired location for the corresponding pivot tables are on worksheet "Career Path and Dev. Plan" Area 1=B33, Area 2=D33, Area 3=F33 and Area 4=H33.


Based on the macro code the pivot tables are not copy and pasting in the correct cells (or at all in some cases).

Please let me know what other info is needed, or what I can do to simplify.

Thank you!
 
Last edited:

Jerry Sullivan

MrExcel MVP
Joined
Mar 18, 2010
Messages
8,787
Luke, Thanks for sending a me a copy of your workbook. It helped me to understand what you are wanting.

Just one clarification...
Do you want to paste actual working PivotTables onto the Summary sheet or just the Values and Formats? (The fact that your template pivots are collapsed makes me think it's the former, but the ranges you were copying in the Original Post code doesn't include the header row for the Pivots).
 

Tritritri

New Member
Joined
Jan 6, 2014
Messages
5

ADVERTISEMENT

I am hoping to get the actual PivotTables onto the summary sheet. In cleaning up the workbook before sending it to you I deleted the top row from the Pivots tab and forgot to make to adjustment to the code.
 

Jerry Sullivan

MrExcel MVP
Joined
Mar 18, 2010
Messages
8,787
Luke, I've sent you a copy of the file with a suggested approach since there are many changes in addition to code.

As an overview, here's what I'd suggest.

Use a table like this to distill the user responses into a form that will be simple for the copy-pivots VBA to process...
Excel Workbook
ABCDE
58Column Index NumberMax Development Plans
59,INDEX(Inputs!inpEvaluations,1,0),0)]54
60
61BehaviorEvaluationBelowStandardCopyDevelopmentPlanPivotTableName
62Behavior1EffectiveIneffectiveNoC
63Behavior2IneffectiveIneffectiveYesL
64Behavior3EffectiveIneffectiveNoA
65Behavior4IneffectiveIneffectiveYesCom
66Behavior5Does not meet expectationDoes not meet expectationYesP
67Behavior6EffectiveDoes not meet expectationNoPCS
68Behavior7Does not meet expectationDoes not meet expectationYesE
69Behavior8EffectiveDoes not meet expectationNoCI
Sheet


With that in place, the VBA code can become relatively simple.

Code:
Option Explicit

'This code references these worksheets by their CodeName property:
'  wksCalcs, wksInputs, wksPivots, wksSummary

Sub CheckInputsAndCopyPivots()
'---This checks user responses and copies template pivots
'   to a summary sheet based on those responses.
'   The user responses are summarized in tblPivotMap.
'   For each "Yes" value found in field CopyDevelopmentPlan,
'   the sub looks up the corresponding PivotTable name
'   then calls a procedure to copy that pivot to a destination.

 Dim lCopyNbr As Long
 Dim rCell As Range
 Dim sPivotName As String
 
 With wksCalcs
   For Each rCell In .Range("tblPivotMap[CopyDevelopmentPlan]")
      If rCell.Value = "Yes" Then
         lCopyNbr = lCopyNbr + 1
         '--lookup PivotTable name in same row of tblPivotMap
         sPivotName = .Cells(rCell.Row, _
            .Range("tblPivotMap[PivotTableName]").Column).Value
         Call CopyPivot(sPivotName:=sPivotName, _
            lDestNbr:=lCopyNbr)
      End If
   Next rCell
 End With
End Sub


Sub CopyPivot(ByVal sPivotName As String, _
   ByVal lDestNbr As Long)
'---This attemps to copy the entire pivottable and
'   paste it to a destination on the Summary sheet.
'   The destination is the cell below a named range
'   specified by the concatenation of the
'   sDEV_AREA_PREFIX and lDestNbr.
   
 Const sDEV_AREA_PREFIX = "ptrDevArea"

 On Error Resume Next

 wksPivots.PivotTables(sPivotName).TableRange2.Copy _
   Destination:=wksSummary.Range(sDEV_AREA_PREFIX _
      & CStr(lDestNbr)).Offset(1)

 If Err.Number <> 0 Then _
   MsgBox "Unable to copy and paste Pivot Table for " _
       & "Development Area #" & CStr(lDestNbr) _
       & vbLf & vbLf & Err.Number & "-" & Err.Description
 On Error GoTo 0
End Sub
 

Tritritri

New Member
Joined
Jan 6, 2014
Messages
5
Jerry,

This is great! My spreadsheet now does exactly what I want it to do. I appreciate all of the support you provided!

-Luke
 

Forum statistics

Threads
1,137,298
Messages
5,680,678
Members
419,924
Latest member
Dhamodharan992

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top