By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
435,396 Members | 2,501 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 435,396 IT Pros & Developers. It's quick & easy.

Excel macro - combine multiple sheets into pivottable

P: 1
Hello, I am totaly new to VBA and I'm trying to modify a macro that was given to me but it doesn't seem to be working. I'm trying to extract data from three excel spreadsheets, put it into a combined one which creates a pivot table and sorts it into different fromats. Here is the code, can any body help?

Expand|Select|Wrap|Line Numbers
  1. Sub Update_Land_Actuals()
  2. On Error Resume Next
  3. If InputBox("Enter password to continue", "Centex Homes") <> "***" Then Exit Sub
  4. Sheets("Detail").Visible = True
  5. Application.DisplayAlerts = False
  6. Sheets("Actuals").Delete
  7. Application.DisplayAlerts = True
  8. Sheets("Detail").Select
  9. Sheets("Detail").Cells.ClearContents
  10.     Call GetRetrievedData
  11.     Call CombineData
  12.     Call FormatTotalsSheet
  13. Application.ScreenUpdating = True
  14. MsgBox "Land Actuals updated", vbOKOnly + vbInformation, "Centex Homes"
  15. End Sub
  16.  
  17.  
  18. Private Sub GetRetrievedData()
  19. On Error Resume Next
  20. Dim i As Integer, CompositeBook As String
  21. CompositeBook = ThisWorkbook.Name
  22. Const DownloadFile As String = "ActualsDownload"
  23.  
  24. Application.ScreenUpdating = False
  25. Application.ShowWindowsInTaskbar = False
  26.     For i = 1 To 3
  27.         Workbooks.Open Filename:=DownloadPath & DownloadFile & i & ".xls"
  28.             ActiveSheet.Copy Before:=Workbooks(CompositeBook).Sheets(1)
  29.             ActiveSheet.Move After:=Sheets(Sheets.Count)
  30.         Windows(DownloadFile & i & ".xls").Close (False)
  31.     Next i
  32.     Application.ShowWindowsInTaskbar = True
  33.    Sheets("Detail").Select
  34. End Sub
  35.  
  36.  
  37. Private Sub CombineData()
  38. Dim i As Integer
  39. Const DownloadFile As String = "ActualsDownload"
  40. Application.ScreenUpdating = False
  41.     Sheets("Detail").Select
  42.     Cells.Clear
  43.     For i = 1 To 3
  44.         Sheets(DownloadFile & i).Select
  45.                 Range(Range("A2"), Range("A2").End(xlToRight)).Select
  46.                 Range(Selection, Selection.End(xlDown)).Select
  47.             Selection.Copy
  48.             Sheets("Detail").Select
  49.             Selection.End(xlDown).Select
  50.         Range("A65000").End(xlUp).Offset(1, 0).Select
  51.     ActiveSheet.Paste
  52.     Application.CutCopyMode = False
  53.     Next i
  54.         Application.DisplayAlerts = False
  55.             For i = 1 To 3
  56.                 Sheets(DownloadFile & i).Select
  57.                 ActiveWindow.SelectedSheets.Delete
  58.             Next
  59.         Cells.EntireColumn.AutoFit
  60.         Application.DisplayAlerts = True
  61. End Sub
  62.  
  63.  
  64. Private Sub FormatTotalsSheet()
  65. On Error Resume Next
  66.     Dim cell As Range
  67.     Application.ScreenUpdating = False
  68.         Cells.Font.Size = 8
  69.     For Each cell In Range(Range("A2"), Range("A2").End(xlDown))
  70.         cell = cell & "LD" & cell.Offset(0, 1)
  71.     Next
  72.         For Each cell In Range(Range("G2:H2"), Range("G2:H2").End(xlDown))
  73.             cell = cell.Value
  74.         Next
  75.     Columns("B:B").Delete Shift:=xlToLeft
  76.         Range("A1") = "JOB"
  77.         Range("B1") = "CC"
  78.         Range("C1") = "DESCRIPTION"
  79.         Range("D1") = "VENDOR"
  80.         Range("E1") = "REFERENCE"
  81.         Range("F1") = "AMOUNT"
  82.         Range("G1") = "DATE"
  83.     Columns("F:F").Style = "Comma"
  84.     Rows("1:1").Font.Bold = True
  85.     Rows("1:1").HorizontalAlignment = xlCenter
  86.     Cells.EntireColumn.AutoFit
  87.     Columns("G:G").NumberFormat = "mm/dd/yy"
  88.         Range("A1").CurrentRegion.Select
  89.         Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("B2") _
  90.             , Order2:=xlAscending, Key3:=Range("G2"), Order3:=xlAscending, Header:= _
  91.             xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
  92.     Range("A2").Select
  93.     ActiveWindow.FreezePanes = True
  94. End Sub
  95.  
  96.  
  97. Sub Create_Actuals_Pivot()
  98.     '****** DYNAMIC PIVOT TABLE********
  99.     On Error Resume Next
  100.         If InputBox("Enter password to continue", "Centex Homes") <> "***" Then Exit Sub
  101.         Application.ScreenUpdating = False
  102.         Application.DisplayAlerts = False
  103.             Sheets("Detail").Visible = True
  104.             Sheets("Detail").Select
  105.             Sheets("Actuals").Delete
  106.         Application.DisplayAlerts = True
  107.  
  108.     '****** DYNAMIC PIVOT TABLE START********
  109.         Sheets("Detail").Select
  110.         ActiveSheet.Range("A1").Select
  111.         Dim DataSource As Range, i As Integer, cell As Range
  112.         Set DataSource = Range("A1").CurrentRegion
  113.         Application.ScreenUpdating = False
  114.         ActiveSheet.PivotTableWizard SourceType:=xlDatabase, SourceData:= _
  115.             DataSource, TableDestination:="", TableName:="CCPivotTable"
  116.         ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
  117.  
  118.         ActiveSheet.Cells(3, 1).Select
  119.         ActiveSheet.PivotTables("CCPivotTable").SmallGrid = False
  120.         ActiveSheet.PivotTables("CCPivotTable").AddFields RowFields:="CC", PageFields _
  121.         :="JOB"
  122.  
  123.         With ActiveSheet.PivotTables("CCPivotTable").PivotFields("AMOUNT")
  124.             .Orientation = xlDataField
  125.             .Caption = "Cost Code Totals"
  126.             .NumberFormat = "_(* #,##0.00_);_(* (#,##0.00);_(* ""-""??_);_(@_)"
  127.         End With
  128.  
  129.                 Application.CommandBars("PivotTable").Visible = False
  130.     '****** DYNAMIC PIVOT TABLE END********
  131.     ActiveSheet.Name = "Actuals"
  132.  
  133.     For Each cell In Range(Range("B5"), Range("B5").End(xlDown))
  134.         cell.Offset(0, 1).FormulaR1C1 = "=IF(ISNA(VLOOKUP(RC[-2],CostCodes!R2C1:R40000C3,2,FALSE)),"""", VLOOKUP(RC[-2],CostCodes!R2C1:R40000C3,2,FALSE))"
  135.     Next
  136.  
  137.     Cells.Font.Size = 8
  138.     Cells.EntireColumn.AutoFit
  139.     Range("C4") = "Description"
  140.     Rows("4:4").Font.Bold = True
  141.     Rows("4:4").HorizontalAlignment = xlCenter
  142.     Range("B1").Select
  143.     Range("B1").Font.Size = 11
  144.     Range("B1").Font.Bold = 11
  145.     Range("C1").FormulaR1C1 = "=IF(ISNA(VLOOKUP(RC[-1],LandJobs!R[1]C[-2]:R[300]C[1],4,FALSE)),"""", VLOOKUP(RC[-1],LandJobs!R[1]C[-2]:R[300]C[1],4,FALSE))"
  146.     Range("C1").InsertIndent 1
  147.     Range("C1").Font.Size = 11
  148.     Range("C1").Font.Bold = True
  149.     Range("C1:E1").Merge True
  150.     ActiveSheet.ScrollArea = "A1:B200"
  151.     ActiveSheet.PivotTables("CCPivotTable").EnableDrilldown = False
  152.     Sheets("Detail").Visible = False
  153.     Call ShowDetailButton
  154.     Application.ScreenUpdating = True
  155. End Sub
  156.  
  157.  
  158. Private Sub Detail()
  159. On Error GoTo Err_DetailHandler
  160. Dim CostCode As String
  161. CostCode = Range("A" & ActiveCell.Row).Value
  162. Application.ScreenUpdating = False
  163.     If WorksheetFunction.Sum(ActiveCell.EntireRow) = 0 Then Exit Sub
  164.     If Range("A" & ActiveCell.Row).Value > 70000 And Range("A" & ActiveCell.Row).Value < 79999 = False Then Exit Sub
  165.     ActiveSheet.PivotTables("CCPivotTable").EnableDrilldown = True
  166.     ActiveCell.ShowDetail = True
  167.     ActiveSheet.Name = "Detail for C.C. " & CostCode
  168.     Cells.Font.Size = 8
  169.     Columns("F:F").Style = "Comma"
  170.     Range("A1").Select
  171.     Selection.Sort Key1:=Range("G2"), Order1:=xlAscending, Header:=xlGuess, _
  172.         OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
  173.     Range("A2").Select
  174.     ActiveWindow.FreezePanes = True
  175.     Columns("G:G").NumberFormat = "mm/dd/yy"
  176.     Range("F10000").End(xlUp).Offset(1, 0).Select
  177.     ActiveCell = "=SUM(" & ActiveCell.Offset(-1, 0).End(xlUp).Address & ":" & ActiveCell.Offset(-1, 0).Address & ")"
  178.     ActiveCell.Font.Bold = True
  179.     Cells.EntireColumn.AutoFit
  180.     ActiveSheet.Buttons.Add(535, 16.5, 126.75, 18).Select
  181.     Selection.OnAction = "HideDetail"
  182.     Selection.Characters.Text = "Hide Detail"
  183.         With Selection.Characters(Start:=1, Length:=11).Font
  184.             .FontStyle = "Bold"
  185.             .Size = 8
  186.         End With
  187.  
  188.     Range("A2").Select
  189.  
  190. Exit Sub
  191.  
  192. Err_DetailHandler:
  193.     If Err.Number = 1004 Then
  194.         Range("B" & ActiveCell.Row).Select
  195.            Resume
  196.     Else
  197.         Exit Sub
  198.     End If
  199. End Sub
  200.  
  201.  
  202. Private Sub HideDetail()
  203. Application.DisplayAlerts = False
  204.     If Left(ActiveSheet.Name, 10) = "Detail for" Then ActiveWindow.SelectedSheets.Delete
  205.     Sheets("Actuals").Select
  206.  
  207.     ActiveSheet.PivotTables("CCPivotTable").EnableDrilldown = False
  208. Application.DisplayAlerts = True
  209. End Sub
  210.  
  211.  
  212. Private Sub ShowDetailButton()
  213.     Rows("2:2").RowHeight = 26.25
  214.     ActiveSheet.Buttons.Add(141.75, 20.25, 129, 16.5).Select
  215.     Selection.OnAction = "Detail"
  216.     Selection.Characters.Text = "Show Cost Code Detail"
  217.     With Selection.Characters(Start:=1, Length:=21).Font
  218.         .FontStyle = "Bold"
  219.         .Size = 8
  220.         End With
  221.     Range("a5").Select
  222.     ActiveWindow.FreezePanes = True
  223. End Sub
Aug 21 '07 #1
Share this question for a faster answer!
Share on Google+

Post your reply

Sign in to post your reply or Sign up for a free account.