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?
[CODE=vb]Sub Update_Land_Act uals()
On Error Resume Next
If InputBox("Enter password to continue", "Centex Homes") <> "***" Then Exit Sub
Sheets("Detail" ).Visible = True
Application.Dis playAlerts = False
Sheets("Actuals ").Delete
Application.Dis playAlerts = True
Sheets("Detail" ).Select
Sheets("Detail" ).Cells.ClearCo ntents
Call GetRetrievedDat a
Call CombineData
Call FormatTotalsShe et
Application.Scr eenUpdating = True
MsgBox "Land Actuals updated", vbOKOnly + vbInformation, "Centex Homes"
End Sub
Private Sub GetRetrievedDat a()
On Error Resume Next
Dim i As Integer, CompositeBook As String
CompositeBook = ThisWorkbook.Na me
Const DownloadFile As String = "ActualsDownloa d"
Application.Scr eenUpdating = False
Application.Sho wWindowsInTaskb ar = False
For i = 1 To 3
Workbooks.Open Filename:=Downl oadPath & DownloadFile & i & ".xls"
ActiveSheet.Cop y Before:=Workboo ks(CompositeBoo k).Sheets(1)
ActiveSheet.Mov e After:=Sheets(S heets.Count)
Windows(Downloa dFile & i & ".xls").Clo se (False)
Next i
Application.Sho wWindowsInTaskb ar = True
Sheets("Detail" ).Select
End Sub
Private Sub CombineData()
Dim i As Integer
Const DownloadFile As String = "ActualsDownloa d"
Application.Scr eenUpdating = False
Sheets("Detail" ).Select
Cells.Clear
For i = 1 To 3
Sheets(Download File & i).Select
Range(Range("A2 "), Range("A2").End (xlToRight)).Se lect
Range(Selection , Selection.End(x lDown)).Select
Selection.Copy
Sheets("Detail" ).Select
Selection.End(x lDown).Select
Range("A65000") .End(xlUp).Offs et(1, 0).Select
ActiveSheet.Pas te
Application.Cut CopyMode = False
Next i
Application.Dis playAlerts = False
For i = 1 To 3
Sheets(Download File & i).Select
ActiveWindow.Se lectedSheets.De lete
Next
Cells.EntireCol umn.AutoFit
Application.Dis playAlerts = True
End Sub
Private Sub FormatTotalsShe et()
On Error Resume Next
Dim cell As Range
Application.Scr eenUpdating = False
Cells.Font.Size = 8
For Each cell In Range(Range("A2 "), Range("A2").End (xlDown))
cell = cell & "LD" & cell.Offset(0, 1)
Next
For Each cell In Range(Range("G2 :H2"), Range("G2:H2"). End(xlDown))
cell = cell.Value
Next
Columns("B:B"). Delete Shift:=xlToLeft
Range("A1") = "JOB"
Range("B1") = "CC"
Range("C1") = "DESCRIPTIO N"
Range("D1") = "VENDOR"
Range("E1") = "REFERENCE"
Range("F1") = "AMOUNT"
Range("G1") = "DATE"
Columns("F:F"). Style = "Comma"
Rows("1:1").Fon t.Bold = True
Rows("1:1").Hor izontalAlignmen t = xlCenter
Cells.EntireCol umn.AutoFit
Columns("G:G"). NumberFormat = "mm/dd/yy"
Range("A1").Cur rentRegion.Sele ct
Selection.Sort Key1:=Range("A2 "), Order1:=xlAscen ding, Key2:=Range("B2 ") _
, Order2:=xlAscen ding, Key3:=Range("G2 "), Order3:=xlAscen ding, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=Fals e, Orientation:=xl TopToBottom
Range("A2").Sel ect
ActiveWindow.Fr eezePanes = True
End Sub
Sub Create_Actuals_ Pivot()
'****** DYNAMIC PIVOT TABLE********
On Error Resume Next
If InputBox("Enter password to continue", "Centex Homes") <> "***" Then Exit Sub
Application.Scr eenUpdating = False
Application.Dis playAlerts = False
Sheets("Detail" ).Visible = True
Sheets("Detail" ).Select
Sheets("Actuals ").Delete
Application.Dis playAlerts = True
'****** DYNAMIC PIVOT TABLE START********
Sheets("Detail" ).Select
ActiveSheet.Ran ge("A1").Selec t
Dim DataSource As Range, i As Integer, cell As Range
Set DataSource = Range("A1").Cur rentRegion
Application.Scr eenUpdating = False
ActiveSheet.Piv otTableWizard SourceType:=xlD atabase, SourceData:= _
DataSource, TableDestinatio n:="", TableName:="CCP ivotTable"
ActiveSheet.Piv otTableWizard TableDestinatio n:=ActiveSheet. Cells(3, 1)
ActiveSheet.Cel ls(3, 1).Select
ActiveSheet.Piv otTables("CCPiv otTable").Small Grid = False
ActiveSheet.Piv otTables("CCPiv otTable").AddFi elds RowFields:="CC" , PageFields _
:="JOB"
With ActiveSheet.Piv otTables("CCPiv otTable").Pivot Fields("AMOUNT" )
.Orientation = xlDataField
.Caption = "Cost Code Totals"
.NumberFormat = "_(* #,##0.00_);_(* (#,##0.00);_(* ""-""??_);_(@_ )"
End With
Application.Com mandBars("Pivot Table").Visible = False
'****** DYNAMIC PIVOT TABLE END********
ActiveSheet.Nam e = "Actuals"
For Each cell In Range(Range("B5 "), Range("B5").End (xlDown))
cell.Offset(0, 1).FormulaR1C1 = "=IF(ISNA(VLOOK UP(RC[-2],CostCodes!R2C1 :R40000C3,2,FAL SE)),"""", VLOOKUP(RC[-2],CostCodes!R2C1 :R40000C3,2,FAL SE))"
Next
Cells.Font.Size = 8
Cells.EntireCol umn.AutoFit
Range("C4") = "Descriptio n"
Rows("4:4").Fon t.Bold = True
Rows("4:4").Hor izontalAlignmen t = xlCenter
Range("B1").Sel ect
Range("B1").Fon t.Size = 11
Range("B1").Fon t.Bold = 11
Range("C1").For mulaR1C1 = "=IF(ISNA(VLOOK UP(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))"
Range("C1").Ins ertIndent 1
Range("C1").Fon t.Size = 11
Range("C1").Fon t.Bold = True
Range("C1:E1"). Merge True
ActiveSheet.Scr ollArea = "A1:B200"
ActiveSheet.Piv otTables("CCPiv otTable").Enabl eDrilldown = False
Sheets("Detail" ).Visible = False
Call ShowDetailButto n
Application.Scr eenUpdating = True
End Sub
Private Sub Detail()
On Error GoTo Err_DetailHandl er
Dim CostCode As String
CostCode = Range("A" & ActiveCell.Row) .Value
Application.Scr eenUpdating = False
If WorksheetFuncti on.Sum(ActiveCe ll.EntireRow) = 0 Then Exit Sub
If Range("A" & ActiveCell.Row) .Value > 70000 And Range("A" & ActiveCell.Row) .Value < 79999 = False Then Exit Sub
ActiveSheet.Piv otTables("CCPiv otTable").Enabl eDrilldown = True
ActiveCell.Show Detail = True
ActiveSheet.Nam e = "Detail for C.C. " & CostCode
Cells.Font.Size = 8
Columns("F:F"). Style = "Comma"
Range("A1").Sel ect
Selection.Sort Key1:=Range("G2 "), Order1:=xlAscen ding, Header:=xlGuess , _
OrderCustom:=1, MatchCase:=Fals e, Orientation:=xl TopToBottom
Range("A2").Sel ect
ActiveWindow.Fr eezePanes = True
Columns("G:G"). NumberFormat = "mm/dd/yy"
Range("F10000") .End(xlUp).Offs et(1, 0).Select
ActiveCell = "=SUM(" & ActiveCell.Offs et(-1, 0).End(xlUp).Ad dress & ":" & ActiveCell.Offs et(-1, 0).Address & ")"
ActiveCell.Font .Bold = True
Cells.EntireCol umn.AutoFit
ActiveSheet.But tons.Add(535, 16.5, 126.75, 18).Select
Selection.OnAct ion = "HideDetail "
Selection.Chara cters.Text = "Hide Detail"
With Selection.Chara cters(Start:=1, Length:=11).Fon t
.FontStyle = "Bold"
.Size = 8
End With
Range("A2").Sel ect
Exit Sub
Err_DetailHandl er:
If Err.Number = 1004 Then
Range("B" & ActiveCell.Row) .Select
Resume
Else
Exit Sub
End If
End Sub
Private Sub HideDetail()
Application.Dis playAlerts = False
If Left(ActiveShee t.Name, 10) = "Detail for" Then ActiveWindow.Se lectedSheets.De lete
Sheets("Actuals ").Select
ActiveSheet.Piv otTables("CCPiv otTable").Enabl eDrilldown = False
Application.Dis playAlerts = True
End Sub
Private Sub ShowDetailButto n()
Rows("2:2").Row Height = 26.25
ActiveSheet.But tons.Add(141.75 , 20.25, 129, 16.5).Select
Selection.OnAct ion = "Detail"
Selection.Chara cters.Text = "Show Cost Code Detail"
With Selection.Chara cters(Start:=1, Length:=21).Fon t
.FontStyle = "Bold"
.Size = 8
End With
Range("a5").Sel ect
ActiveWindow.Fr eezePanes = True
End Sub[/CODE]
[CODE=vb]Sub Update_Land_Act uals()
On Error Resume Next
If InputBox("Enter password to continue", "Centex Homes") <> "***" Then Exit Sub
Sheets("Detail" ).Visible = True
Application.Dis playAlerts = False
Sheets("Actuals ").Delete
Application.Dis playAlerts = True
Sheets("Detail" ).Select
Sheets("Detail" ).Cells.ClearCo ntents
Call GetRetrievedDat a
Call CombineData
Call FormatTotalsShe et
Application.Scr eenUpdating = True
MsgBox "Land Actuals updated", vbOKOnly + vbInformation, "Centex Homes"
End Sub
Private Sub GetRetrievedDat a()
On Error Resume Next
Dim i As Integer, CompositeBook As String
CompositeBook = ThisWorkbook.Na me
Const DownloadFile As String = "ActualsDownloa d"
Application.Scr eenUpdating = False
Application.Sho wWindowsInTaskb ar = False
For i = 1 To 3
Workbooks.Open Filename:=Downl oadPath & DownloadFile & i & ".xls"
ActiveSheet.Cop y Before:=Workboo ks(CompositeBoo k).Sheets(1)
ActiveSheet.Mov e After:=Sheets(S heets.Count)
Windows(Downloa dFile & i & ".xls").Clo se (False)
Next i
Application.Sho wWindowsInTaskb ar = True
Sheets("Detail" ).Select
End Sub
Private Sub CombineData()
Dim i As Integer
Const DownloadFile As String = "ActualsDownloa d"
Application.Scr eenUpdating = False
Sheets("Detail" ).Select
Cells.Clear
For i = 1 To 3
Sheets(Download File & i).Select
Range(Range("A2 "), Range("A2").End (xlToRight)).Se lect
Range(Selection , Selection.End(x lDown)).Select
Selection.Copy
Sheets("Detail" ).Select
Selection.End(x lDown).Select
Range("A65000") .End(xlUp).Offs et(1, 0).Select
ActiveSheet.Pas te
Application.Cut CopyMode = False
Next i
Application.Dis playAlerts = False
For i = 1 To 3
Sheets(Download File & i).Select
ActiveWindow.Se lectedSheets.De lete
Next
Cells.EntireCol umn.AutoFit
Application.Dis playAlerts = True
End Sub
Private Sub FormatTotalsShe et()
On Error Resume Next
Dim cell As Range
Application.Scr eenUpdating = False
Cells.Font.Size = 8
For Each cell In Range(Range("A2 "), Range("A2").End (xlDown))
cell = cell & "LD" & cell.Offset(0, 1)
Next
For Each cell In Range(Range("G2 :H2"), Range("G2:H2"). End(xlDown))
cell = cell.Value
Next
Columns("B:B"). Delete Shift:=xlToLeft
Range("A1") = "JOB"
Range("B1") = "CC"
Range("C1") = "DESCRIPTIO N"
Range("D1") = "VENDOR"
Range("E1") = "REFERENCE"
Range("F1") = "AMOUNT"
Range("G1") = "DATE"
Columns("F:F"). Style = "Comma"
Rows("1:1").Fon t.Bold = True
Rows("1:1").Hor izontalAlignmen t = xlCenter
Cells.EntireCol umn.AutoFit
Columns("G:G"). NumberFormat = "mm/dd/yy"
Range("A1").Cur rentRegion.Sele ct
Selection.Sort Key1:=Range("A2 "), Order1:=xlAscen ding, Key2:=Range("B2 ") _
, Order2:=xlAscen ding, Key3:=Range("G2 "), Order3:=xlAscen ding, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=Fals e, Orientation:=xl TopToBottom
Range("A2").Sel ect
ActiveWindow.Fr eezePanes = True
End Sub
Sub Create_Actuals_ Pivot()
'****** DYNAMIC PIVOT TABLE********
On Error Resume Next
If InputBox("Enter password to continue", "Centex Homes") <> "***" Then Exit Sub
Application.Scr eenUpdating = False
Application.Dis playAlerts = False
Sheets("Detail" ).Visible = True
Sheets("Detail" ).Select
Sheets("Actuals ").Delete
Application.Dis playAlerts = True
'****** DYNAMIC PIVOT TABLE START********
Sheets("Detail" ).Select
ActiveSheet.Ran ge("A1").Selec t
Dim DataSource As Range, i As Integer, cell As Range
Set DataSource = Range("A1").Cur rentRegion
Application.Scr eenUpdating = False
ActiveSheet.Piv otTableWizard SourceType:=xlD atabase, SourceData:= _
DataSource, TableDestinatio n:="", TableName:="CCP ivotTable"
ActiveSheet.Piv otTableWizard TableDestinatio n:=ActiveSheet. Cells(3, 1)
ActiveSheet.Cel ls(3, 1).Select
ActiveSheet.Piv otTables("CCPiv otTable").Small Grid = False
ActiveSheet.Piv otTables("CCPiv otTable").AddFi elds RowFields:="CC" , PageFields _
:="JOB"
With ActiveSheet.Piv otTables("CCPiv otTable").Pivot Fields("AMOUNT" )
.Orientation = xlDataField
.Caption = "Cost Code Totals"
.NumberFormat = "_(* #,##0.00_);_(* (#,##0.00);_(* ""-""??_);_(@_ )"
End With
Application.Com mandBars("Pivot Table").Visible = False
'****** DYNAMIC PIVOT TABLE END********
ActiveSheet.Nam e = "Actuals"
For Each cell In Range(Range("B5 "), Range("B5").End (xlDown))
cell.Offset(0, 1).FormulaR1C1 = "=IF(ISNA(VLOOK UP(RC[-2],CostCodes!R2C1 :R40000C3,2,FAL SE)),"""", VLOOKUP(RC[-2],CostCodes!R2C1 :R40000C3,2,FAL SE))"
Next
Cells.Font.Size = 8
Cells.EntireCol umn.AutoFit
Range("C4") = "Descriptio n"
Rows("4:4").Fon t.Bold = True
Rows("4:4").Hor izontalAlignmen t = xlCenter
Range("B1").Sel ect
Range("B1").Fon t.Size = 11
Range("B1").Fon t.Bold = 11
Range("C1").For mulaR1C1 = "=IF(ISNA(VLOOK UP(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))"
Range("C1").Ins ertIndent 1
Range("C1").Fon t.Size = 11
Range("C1").Fon t.Bold = True
Range("C1:E1"). Merge True
ActiveSheet.Scr ollArea = "A1:B200"
ActiveSheet.Piv otTables("CCPiv otTable").Enabl eDrilldown = False
Sheets("Detail" ).Visible = False
Call ShowDetailButto n
Application.Scr eenUpdating = True
End Sub
Private Sub Detail()
On Error GoTo Err_DetailHandl er
Dim CostCode As String
CostCode = Range("A" & ActiveCell.Row) .Value
Application.Scr eenUpdating = False
If WorksheetFuncti on.Sum(ActiveCe ll.EntireRow) = 0 Then Exit Sub
If Range("A" & ActiveCell.Row) .Value > 70000 And Range("A" & ActiveCell.Row) .Value < 79999 = False Then Exit Sub
ActiveSheet.Piv otTables("CCPiv otTable").Enabl eDrilldown = True
ActiveCell.Show Detail = True
ActiveSheet.Nam e = "Detail for C.C. " & CostCode
Cells.Font.Size = 8
Columns("F:F"). Style = "Comma"
Range("A1").Sel ect
Selection.Sort Key1:=Range("G2 "), Order1:=xlAscen ding, Header:=xlGuess , _
OrderCustom:=1, MatchCase:=Fals e, Orientation:=xl TopToBottom
Range("A2").Sel ect
ActiveWindow.Fr eezePanes = True
Columns("G:G"). NumberFormat = "mm/dd/yy"
Range("F10000") .End(xlUp).Offs et(1, 0).Select
ActiveCell = "=SUM(" & ActiveCell.Offs et(-1, 0).End(xlUp).Ad dress & ":" & ActiveCell.Offs et(-1, 0).Address & ")"
ActiveCell.Font .Bold = True
Cells.EntireCol umn.AutoFit
ActiveSheet.But tons.Add(535, 16.5, 126.75, 18).Select
Selection.OnAct ion = "HideDetail "
Selection.Chara cters.Text = "Hide Detail"
With Selection.Chara cters(Start:=1, Length:=11).Fon t
.FontStyle = "Bold"
.Size = 8
End With
Range("A2").Sel ect
Exit Sub
Err_DetailHandl er:
If Err.Number = 1004 Then
Range("B" & ActiveCell.Row) .Select
Resume
Else
Exit Sub
End If
End Sub
Private Sub HideDetail()
Application.Dis playAlerts = False
If Left(ActiveShee t.Name, 10) = "Detail for" Then ActiveWindow.Se lectedSheets.De lete
Sheets("Actuals ").Select
ActiveSheet.Piv otTables("CCPiv otTable").Enabl eDrilldown = False
Application.Dis playAlerts = True
End Sub
Private Sub ShowDetailButto n()
Rows("2:2").Row Height = 26.25
ActiveSheet.But tons.Add(141.75 , 20.25, 129, 16.5).Select
Selection.OnAct ion = "Detail"
Selection.Chara cters.Text = "Show Cost Code Detail"
With Selection.Chara cters(Start:=1, Length:=21).Fon t
.FontStyle = "Bold"
.Size = 8
End With
Range("a5").Sel ect
ActiveWindow.Fr eezePanes = True
End Sub[/CODE]