-
Mar 30th, 2018, 09:48 AM
#1
Thread Starter
Don't Panic!
[RESOLVED] Excel - pivot table - vba
Found a post for help on linkedin - thought it would be good to remember how to actually do stuff in vba (not used it for 3 years).
The general request was to open two passworded excel files using vba, combine the data and pivot it. Fairly simple. ish
I managed to make two excel books passworded with a simple two columns of data.
Got it to combine.
And fell flat on my face with the pivot table in vba. Did MS mess it up or am I doing it wrong (obviously the latter but where)?
Code is below, commented out the pivot part I'm stuck with.
Code:
Option Explicit
Public Sub CombineData()
Dim xl As Excel.Application
Dim wrk As Workbook
Dim wrkS As Workbook
Dim sht As Worksheet
Dim shtS As Worksheet
Dim shtP As Worksheet
Dim rng As Range
Dim pvt As PivotTable
Dim pf As PivotField
Dim pfd As PivotField
Dim strFp As String
Dim lngRowOP As Long
Dim lngMaxRows As Long
Dim lngCurRow As Long
Dim bHasTitle As Boolean
Set xl = Application
Set wrk = ActiveWorkbook
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'---- check if there is a combined sheet already - get rid of it if there is
On Error Resume Next
If wrk.Sheets("combined").Name = "combined" Then wrk.Sheets("combined").Delete
If wrk.Sheets("pivot").Name = "pivot" Then wrk.Sheets("pivot").Delete
On Error GoTo 0
Set sht = wrk.Sheets.Add
sht.Name = "combined"
'---- change to loop a selection of file(s) here
strFp = wrk.Path & "\" & "data*.xlsx"
lngRowOP = 2
sht.Cells(1, 1) = "column 1"
sht.Cells(1, 2) = "column 2"
strFp = Dir(strFp, 63)
Do While strFp <> ""
Set wrkS = xl.Workbooks.Open(strFp, , True, , "test")
Set shtS = wrkS.Sheets(1) 'or use the name if the name is the same
bHasTitle = True 'ignore first line
lngMaxRows = shtS.Cells(65535, 1).End(xlUp).Row
' For lngCurRow = 2 To lngMaxRows
' sht.Cells(lngRowOP, 1) = shtS.Cells(lngCurRow, 1)
' sht.Cells(lngRowOP, 2) = shtS.Cells(lngCurRow, 2)
' lngRowOP = lngRowOP + 1
' Next
'---- or
Set rng = shtS.Range(shtS.Cells(2, 1), shtS.Cells(lngMaxRows, 2))
rng.Copy
sht.Cells(lngRowOP, 1).PasteSpecial xlPasteValues
lngRowOP = lngRowOP + lngMaxRows - IIf(bHasTitle, 1, 0)
wrkS.Close
strFp = Dir
Loop
'---- to here ... loop
'do duplicates checks here - if required
'make a pivot table of the data
Set rng = sht.Range(sht.Cells(1, 1), sht.Cells(lngRowOP - 1, 2))
Set shtP = wrk.Worksheets.Add
shtP.Name = "pivot"
Set pvt = wrk.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=rng, Version:=6).CreatePivotTable(TableDestination:=shtP.Cells(3, 1), TableName:="CombinedPvT", DefaultVersion:=6)
With pvt
.ColumnGrand = False
.NullString = "0"
End With
With pvt.PivotFields("column 1")
.Orientation = xlRowField
.Position = 1
End With
Set pf = pvt.PivotFields("column 2")
With pf
.Orientation = xlColumnField
.Position = 1
End With
'Set pfd = pvt.AddDataField(pvt.PivotFields("column 2"), pvt.PivotFields("count of column 2"), xlSum)
'With pfd
' .Caption = "Count"
' .Function = xlCount
'End With
'With pvt.PivotFields("sum of column 2")
' .Caption = "Count"
' .Function = xlCount
'End With
shtP.Cells(1, 1).Select
sht.Select
sht.Cells(1, 1).Select
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Set shtS = Nothing
Set sht = Nothing
Set wrk = Nothing
End Sub
Problem is when I create the data field it removes the column when it shouldn't.
any pointers or is it just vba pivot is more messy than I remember ?
(the base code I recorded a macro, just changed to objects)
Feeling like a fly on the inside of a closed window (Thunk!)
If I post a lot, it is because I am bored at work! ;D Or stuck...
* Anything I post can be only my opinion. Advice etc is up to you to persue...
-
Mar 30th, 2018, 04:26 PM
#2
Re: Excel - pivot table - vba
there was a thread recently that i contributed to, to create a pivot table using vba, after several attempts got it sort of working, though not completely as required, at that point i got busy with some other stuff of my own, so did not look at it further
as i have never really worked with pivot tables i was just working with trial and error, not really knowing what final result was expected, and some stuff not working as i expected
anyway the thread is http://www.vbforums.com/showthread.p...heet-using-VBA
i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next
dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part
come back and mark your original post as resolved if your problem is fixed
pete
-
Mar 30th, 2018, 10:01 PM
#3
Thread Starter
Don't Panic!
Re: Excel - pivot table - vba
Thanks
That did help.
Code:
Option Explicit
Public Sub CombineData()
Dim xl As Excel.Application
Dim wrk As Workbook
Dim wrkS As Workbook
Dim sht As Worksheet
Dim shtS As Worksheet
Dim shtP As Worksheet
Dim rng As Range
Dim pvt As PivotTable
Dim pf As PivotField
Dim pfd As PivotField
Dim strFp As String
Dim lngRowOP As Long
Dim lngMaxRows As Long
Dim lngCurRow As Long
Dim bHasTitle As Boolean
Set xl = Application
Set wrk = ActiveWorkbook
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'---- check if there is a combined sheet already - get rid of it if there is
On Error Resume Next
If wrk.Sheets("combined").Name = "combined" Then wrk.Sheets("combined").Delete
If wrk.Sheets("pivot").Name = "pivot" Then wrk.Sheets("pivot").Delete
On Error GoTo 0
Set sht = wrk.Sheets.Add
sht.Name = "combined"
'---- change to loop a selection of file(s) here
strFp = wrk.Path & "\" & "data*.xlsx"
lngRowOP = 2
sht.Cells(1, 1) = "column 1"
sht.Cells(1, 2) = "column 2"
strFp = Dir(strFp, 63)
Do While strFp <> ""
Set wrkS = xl.Workbooks.Open(strFp, , True, , "test")
Set shtS = wrkS.Sheets(1) 'or use the name if the name is the same
bHasTitle = True 'ignore first line
lngMaxRows = shtS.Cells(65535, 1).End(xlUp).Row
' For lngCurRow = 2 To lngMaxRows
' sht.Cells(lngRowOP, 1) = shtS.Cells(lngCurRow, 1)
' sht.Cells(lngRowOP, 2) = shtS.Cells(lngCurRow, 2)
' lngRowOP = lngRowOP + 1
' Next
'---- or
Set rng = shtS.Range(shtS.Cells(2, 1), shtS.Cells(lngMaxRows, 2))
rng.Copy
sht.Cells(lngRowOP, 1).PasteSpecial xlPasteValues
lngRowOP = lngRowOP + lngMaxRows - IIf(bHasTitle, 1, 0)
wrkS.Close
strFp = Dir
Loop
'---- to here ... loop
'do duplicates checks here - if required
'make a pivot table of the data
Set rng = sht.Range(sht.Cells(1, 1), sht.Cells(lngRowOP - 1, 2))
Set shtP = wrk.Worksheets.Add
shtP.Name = "pivot"
Set pvt = wrk.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=rng, Version:=6).CreatePivotTable(TableDestination:=shtP.Cells(3, 1), TableName:="CombinedPvT", DefaultVersion:=6)
With pvt
.ColumnGrand = False
.NullString = "0"
End With
With pvt.PivotFields("column 1")
.Orientation = xlRowField
.Position = 1
End With
Set pf = pvt.PivotFields("column 2")
With pf
.Orientation = xlColumnField
.Position = 1
End With
Set pfd = pvt.PivotFields("column 2")
With pfd
.Position = 1
.Orientation = xlDataField
.Function = xlCount
.Caption = "Count of Col 2"
End With
shtP.Cells(1, 1).Select
sht.Select
sht.Cells(1, 1).Select
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Set pvt = nothing
Set pf = nothing
Set pfd = nothing
Set shtP = nothing
Set shtS = Nothing
Set sht = Nothing
Set wrk = Nothing
End Sub
Just a bit wierd creating the field then changing to a data one. But works !
Feeling like a fly on the inside of a closed window (Thunk!)
If I post a lot, it is because I am bored at work! ;D Or stuck...
* Anything I post can be only my opinion. Advice etc is up to you to persue...
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|