Running a macro when new data is imported into a worksheet

Thuynh08

New Member
Joined
Aug 17, 2011
Messages
30
Hi All,

I'm totally stuck :confused: 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
 

Excel Facts

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.

Forum statistics

Threads
1,224,525
Messages
6,179,314
Members
452,905
Latest member
deadwings

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
Back
Top