Hi All,
I'm totally stuck I've got the concept laid out in my head but can't seem to get the macros right. Basically what I am trying to achieve is when data is copied into the 'Data' worksheet a new heading Material ID with a formula LEFT is created. From this I want a pivot table with the main headings and sales values (although this may change when new data is imported could be sales units etc). What i've managed to do is when the data is imported you will need to click on a different tab and go back to that 'Data' tab in order for the message box to appear. I realise this is flawed as you need to click back and forth from tabs in order for the message box to appear. How can I have the macro run to create the new "Material ID" heading/formula AND create a pivot table when i add new data in? Bleh hope this makes sense...
Any help is much appreciated thank you!!!
Code when the tab is clicked:
Private Sub Worksheet_Activate()
Dim nResult As Long
nResult = MsgBox( _
Prompt:="Update Data?", _
Buttons:=vbYesNoCancel)
If nResult = vbYes Then
Sheets("Pivot").Cells.Clear
Sheets("Data").Select
Application.Run _
"Find_First"
End If
End Sub
Find_First Macro
Sub Find_First()
Dim FindString As String
Dim Rng As Range
FindString = "Material"
If Trim(FindString) <> "" Then
With Sheets("Data").Range("A:Z")
Set Rng = .Find(What:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
Application.Goto Rng, True
Else
MsgBox "Nothing found"
End If
End With
End If
cl = ActiveCell.Column
lr = Cells(Rows.Count, cl).End(xlUp).Row
ActiveCell.EntireColumn.Offset(0, 1).Insert
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "Material ID"
With ActiveCell.Characters(Start:=1, Length:=11).Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
ActiveCell.Offset(1, 0).Select
ActiveCell.FormulaR1C1 = "=LEFT(RC[-1],13)"
fr = ActiveCell.Row
Range(Cells(fr, cl + 1), Cells(lr, cl + 1)).FillDown
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"Data!R1C1:R961C18", Version:=xlPivotTableVersion12).CreatePivotTable _
TableDestination:="Pivot!R1C1", TableName:="PivotTable3", DefaultVersion _
:=xlPivotTableVersion12
Sheets("Pivot").Select
Cells(1, 1).Select
ActiveWorkbook.ShowPivotTableFieldList = True
With ActiveSheet.PivotTables("PivotTable3").PivotFields("Material ID")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable3").PivotFields("Consumer category 1")
.Orientation = xlRowField
.Position = 2
End With
With ActiveSheet.PivotTables("PivotTable3").PivotFields("Consumer category 2")
.Orientation = xlRowField
.Position = 3
End With
With ActiveSheet.PivotTables("PivotTable3").PivotFields("Consumer category 3")
.Orientation = xlRowField
.Position = 4
End With
With ActiveSheet.PivotTables("PivotTable3").PivotFields("Consumer category 4")
.Orientation = xlRowField
.Position = 5
End With
With ActiveSheet.PivotTables("PivotTable3").PivotFields("Consumer category 5")
.Orientation = xlRowField
.Position = 6
End With
ActiveSheet.PivotTables("PivotTable3").AddDataField ActiveSheet.PivotTables( _
"PivotTable3").PivotFields("Overall Result"), "Sum of Overall Result", xlSum
ActiveSheet.PivotTables("PivotTable3").RowAxisLayout xlOutlineRow
End Sub
I'm totally stuck I've got the concept laid out in my head but can't seem to get the macros right. Basically what I am trying to achieve is when data is copied into the 'Data' worksheet a new heading Material ID with a formula LEFT is created. From this I want a pivot table with the main headings and sales values (although this may change when new data is imported could be sales units etc). What i've managed to do is when the data is imported you will need to click on a different tab and go back to that 'Data' tab in order for the message box to appear. I realise this is flawed as you need to click back and forth from tabs in order for the message box to appear. How can I have the macro run to create the new "Material ID" heading/formula AND create a pivot table when i add new data in? Bleh hope this makes sense...
Any help is much appreciated thank you!!!
Code when the tab is clicked:
Private Sub Worksheet_Activate()
Dim nResult As Long
nResult = MsgBox( _
Prompt:="Update Data?", _
Buttons:=vbYesNoCancel)
If nResult = vbYes Then
Sheets("Pivot").Cells.Clear
Sheets("Data").Select
Application.Run _
"Find_First"
End If
End Sub
Find_First Macro
Sub Find_First()
Dim FindString As String
Dim Rng As Range
FindString = "Material"
If Trim(FindString) <> "" Then
With Sheets("Data").Range("A:Z")
Set Rng = .Find(What:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
Application.Goto Rng, True
Else
MsgBox "Nothing found"
End If
End With
End If
cl = ActiveCell.Column
lr = Cells(Rows.Count, cl).End(xlUp).Row
ActiveCell.EntireColumn.Offset(0, 1).Insert
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "Material ID"
With ActiveCell.Characters(Start:=1, Length:=11).Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
ActiveCell.Offset(1, 0).Select
ActiveCell.FormulaR1C1 = "=LEFT(RC[-1],13)"
fr = ActiveCell.Row
Range(Cells(fr, cl + 1), Cells(lr, cl + 1)).FillDown
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"Data!R1C1:R961C18", Version:=xlPivotTableVersion12).CreatePivotTable _
TableDestination:="Pivot!R1C1", TableName:="PivotTable3", DefaultVersion _
:=xlPivotTableVersion12
Sheets("Pivot").Select
Cells(1, 1).Select
ActiveWorkbook.ShowPivotTableFieldList = True
With ActiveSheet.PivotTables("PivotTable3").PivotFields("Material ID")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable3").PivotFields("Consumer category 1")
.Orientation = xlRowField
.Position = 2
End With
With ActiveSheet.PivotTables("PivotTable3").PivotFields("Consumer category 2")
.Orientation = xlRowField
.Position = 3
End With
With ActiveSheet.PivotTables("PivotTable3").PivotFields("Consumer category 3")
.Orientation = xlRowField
.Position = 4
End With
With ActiveSheet.PivotTables("PivotTable3").PivotFields("Consumer category 4")
.Orientation = xlRowField
.Position = 5
End With
With ActiveSheet.PivotTables("PivotTable3").PivotFields("Consumer category 5")
.Orientation = xlRowField
.Position = 6
End With
ActiveSheet.PivotTables("PivotTable3").AddDataField ActiveSheet.PivotTables( _
"PivotTable3").PivotFields("Overall Result"), "Sum of Overall Result", xlSum
ActiveSheet.PivotTables("PivotTable3").RowAxisLayout xlOutlineRow
End Sub