Sub CreateStatisticalData()
TestOpenFixedWidthFile
createPivotTable
End Sub
Sub TestOpenFixedWidthFile()
Dim myWorkbook As Workbook
Dim vFields As Variant
Dim myFile As String
Dim colNames As Variant
vFields = Array(Array(0, xlGeneralFormat), Array(1, xlGeneralFormat), Array(8, xlGeneralFormat), Array(20, xlGeneralFormat), Array(27, xlGeneralFormat), _
Array(51, xlGeneralFormat), Array(54, xlGeneralFormat), Array(57, xlGeneralFormat), Array(77, xlGeneralFormat), Array(86, xlGeneralFormat), Array(94, xlGeneralFormat), Array(105, xlGeneralFormat), _
Array(116, xlGeneralFormat), Array(126, xlGeneralFormat), Array(130, xlGeneralFormat), Array(140, xlGeneralFormat), Array(151, xlGeneralFormat), _
Array(172, xlGeneralFormat), Array(182, xlGeneralFormat), Array(222, xlGeneralFormat))
Set myWorkbook = OpenFixedWidthFile("C:\dagama\data_merged.txt", 2, vFields)
addHeaders
Columns("P:Q").Select
Selection.NumberFormat = "#,##0.00"
fillInDocumentField
calculateFields
Columns("A:S").Select
Selection.EntireColumn.AutoFit
ActiveSheet.Columns("B").VerticalAlignment = xlVAlignCenter
ActiveSheet.Columns("B").HorizontalAlignment = xlHAlignRight
ActiveSheet.Columns("C").VerticalAlignment = xlVAlignCenter
ActiveSheet.Columns("C").HorizontalAlignment = xlHAlignRight
ActiveSheet.Columns("D").VerticalAlignment = xlVAlignCenter
ActiveSheet.Columns("D").HorizontalAlignment = xlHAlignCenter
ActiveSheet.Range(Cells(1, 1), Cells(1, 19)).HorizontalAlignment = xlHAlignCenter
Set myWorkbook = Nothing
End Sub
Function OpenFixedWidthFile(sFile As String, lStartRow As Long, vFieldInfo As Variant) As Workbook
On Error GoTo ErrHandler
Application.Workbooks.OpenText _
Filename:=sFile, _
StartRow:=lStartRow, _
DataType:=xlFixedWidth, _
FieldInfo:=vFieldInfo
Set OpenFixedWidthFile = ActiveWorkbook
ExitPoint:
Exit Function
ErrHandler:
Set OpenFixedWidthFile = Nothing
Resume ExitPoint
End Function
Sub addHeaders()
colNames = Array("rowtype", "postingKey", "account", "document", "text1", "cur", "currency", "text2", _
"prodGroup", "segment", "salesChannel", "partnerGroup", "businessType", "LLoB", "country", _
"uAmount", "amount", "amType", "text5")
If IsEmpty(Range("A1")) Then
Range("A1").Resize(1, UBound(colNames) + 1).Value = colNames
Else: Range("A1").EntireRow.Insert
Range("A1").Resize(1, UBound(colNames) + 1).Value = colNames
End If
End Sub
Sub fillInDocumentField()
Dim lastRow As Long
Dim DSheet As Worksheet
Set DSheet = Worksheets("data_merged")
lastRow = DSheet.Cells(Rows.Count, 1).End(xlUp).Row
Dim i As Long
Dim j As Long
Dim goOn As Boolean
goOn = True
i = 2
Do Until i > lastRow
If i = 2 And (Left(DSheet.Cells(i, 3).Value, 1)) <> "X" Then
j = i + 1
Do While goOn = True
If Left(DSheet.Cells(j, 3).Value, 1) <> "X" Then
j = j + 1
goOn = True
Else
DSheet.Cells(i, 4).Value = DSheet.Cells(j, 3).Value
goOn = False
End If
Loop
ElseIf Left(DSheet.Cells(i, 3).Value, 1) = "X" Then
DSheet.Cells(i, 4).Value = DSheet.Cells(i, 3).Value
Else
DSheet.Cells(i, 4).Value = DSheet.Cells(i - 1, 4).Value
End If
i = i + 1
Loop
End Sub
Sub calculateFields()
Dim lastRow As Long
Dim DSheet As Worksheet
Set DSheet = Worksheets("data_merged")
lastRow = DSheet.Cells(Rows.Count, 1).End(xlUp).Row
Dim i As Long
Dim j As Long
Dim goOn As Boolean
goOn = True
i = 2
Do Until i > lastRow
If Left(DSheet.Cells(i, 4).Value, 4) = "X001" Or Left(DSheet.Cells(i, 4).Value, 4) = "X002" Or _
Left(DSheet.Cells(i, 4).Value, 4) = "X003" Or Left(DSheet.Cells(i, 4).Value, 4) = "X004" Then
If DSheet.Cells(i, 2).Value = 40 Or DSheet.Cells(i, 2).Value = 1 Or DSheet.Cells(i, 2).Value = 4 Or DSheet.Cells(i, 2).Value = 92 Or DSheet.Cells(i, 2).Value = 93 Then
DSheet.Cells(i, 17).Value = Round(-Abs(DSheet.Cells(i, 16).Value), 2)
Else
DSheet.Cells(i, 17).Value = Round(DSheet.Cells(i, 16).Value, 2)
End If
ElseIf Left(DSheet.Cells(i, 4).Value, 4) = "X006" Or Left(DSheet.Cells(i, 4).Value, 4) = "X008" Or _
Left(DSheet.Cells(i, 4).Value, 4) = "X009" Or Left(DSheet.Cells(i, 4).Value, 5) = "X0025" Then
If DSheet.Cells(i, 2).Value = 40 Or DSheet.Cells(i, 2).Value = 1 Or DSheet.Cells(i, 2).Value = 4 Then
DSheet.Cells(i, 17).Value = Round(-Abs(DSheet.Cells(i, 16).Value), 2)
Else
DSheet.Cells(i, 17).Value = Round(DSheet.Cells(i, 16).Value, 2)
End If
End If
'Calculate the currency field
If i = 2 And DSheet.Cells(i, 6).Value = "" Then
j = i + 1
Do While goOn = True
If DSheet.Cells(j, 6).Value = "" Then
j = j + 1
goOn = True
Else
DSheet.Cells(i, 7).Value = DSheet.Cells(j, 6).Value
goOn = False
End If
Loop
ElseIf DSheet.Cells(i, 6).Value <> "" Then
DSheet.Cells(i, 7).Value = DSheet.Cells(i, 6).Value
Else: DSheet.Cells(i, 7).Value = DSheet.Cells(i - 1, 7).Value
End If
i = i + 1
Loop
End Sub
Sub createPivotTable()
'Declare Variables
Dim PSheet As Worksheet
Dim DSheet As Worksheet
Dim PCache As PivotCache
Dim PTable As pivotTable
Dim PRange As Range
Dim lastRow As Long
Dim LastCol As Long
'Declare Variables
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("PivotTable").Delete
Sheets.Add Before:=ActiveSheet
ActiveSheet.Name = "PivotTable"
Application.DisplayAlerts = True
Set PSheet = Worksheets("PivotTable")
Set DSheet = Worksheets("data_merged")
'Define Data Range
lastRow = DSheet.Cells(Rows.Count, 1).End(xlUp).Row
LastCol = DSheet.Cells(1, Columns.Count).End(xlToLeft).Column
Set PRange = DSheet.Cells(1, 1).Resize(lastRow, LastCol)
'Define Pivot Cache
Set PCache = ActiveWorkbook.PivotCaches.Create _
(SourceType:=xlDatabase, SourceData:=PRange). _
createPivotTable(TableDestination:=PSheet.Cells(2, 2), _
TableName:="SalesPivotTable")
'Insert Blank Pivot Table
Set PTable = PCache.createPivotTable _
(TableDestination:=PSheet.Cells(1, 1), TableName:="SalesPivotTable")
'Edit PivotTable Properties
With ActiveSheet.PivotTables("SalesPivotTable")
.ColumnGrand = True
.HasAutoFormat = True
.DisplayErrorString = False
.DisplayNullString = True
.EnableDrilldown = True
.ErrorString = ""
.MergeLabels = False
.NullString = ""
.PageFieldOrder = 2
.PageFieldWrapCount = 0
.PreserveFormatting = True
.RowGrand = True
.SaveData = True
.PrintTitles = False
.RepeatItemsOnEachPrintedPage = True
.TotalsAnnotation = False
.CompactRowIndent = 1
.InGridDropZones = False
.DisplayFieldCaptions = True
.DisplayMemberPropertyTooltips = False
.DisplayContextTooltips = True
.ShowDrillIndicators = True
.PrintDrillIndicators = False
.AllowMultipleFilters = False
.SortUsingCustomLists = True
.FieldListSortAscending = False
.ShowValuesRow = False
.CalculatedMembersInFilters = False
.RowAxisLayout xlCompactRow
End With
'--------------------------------------------
ActiveSheet.PivotTables("SalesPivotTable").RepeatAllLabels xlRepeatLabels
Range("B5").Select
'--------------------------------------------
With ActiveSheet.PivotTables("SalesPivotTable")
.InGridDropZones = True
.RowAxisLayout xlTabularRow
End With
'Insert Row Fields
With ActiveSheet.PivotTables("SalesPivotTable").PivotFields("document")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("SalesPivotTable").PivotFields("currency")
.Orientation = xlRowField
.Position = 2
End With
With ActiveSheet.PivotTables("SalesPivotTable").PivotFields("amType")
.Orientation = xlRowField
.Position = 3
End With
With ActiveSheet.PivotTables("SalesPivotTable").PivotFields("account")
.Orientation = xlRowField
.Position = 4
End With
'Insert Data Field
ActiveSheet.PivotTables("SalesPivotTable").AddDataField ActiveSheet. _
PivotTables("SalesPivotTable").PivotFields("amount"), "Sum of amount", _
xlSum
Columns("F:F").Select
Selection.NumberFormat = "#,##0.00"
OpenCSVSaveAsXLS
CopyOutput
prepareComparisonSums
End Sub
Sub prepareComparisonSums()
Dim dataWS As Worksheet
Dim pivotWS As Worksheet
Dim salesWS As Worksheet
Dim wbName As String
Dim newBook As Workbook
Dim r As Long
Dim c As Long
Dim lastRow As Long
Dim sumAmount As Double
Dim i As Long
Dim g As Long
Set dataWS = Workbooks("data_merged").Worksheets("data_merged")
Set pivotWS = Workbooks("data_merged").Worksheets("PivotTable")
Set salesWS = Workbooks("data_merged").Worksheets("SalesIncomeCheck")
lastRow = dataWS.Cells(Rows.Count, 1).End(xlUp).Row
Dim argAccount As Range
Dim argAccCrit As String
Dim argDocument As Range
Dim argDocCrit As String
Dim argCurrency As Range
Dim argCurrCrit As String
Dim argAmType As Range
Dim argTypeCrit As String
Dim argTypeCritNot As String
Dim myPivot As pivotTable
Set myPivot = pivotWS.PivotTables("SalesPivotTable")
Dim argAmount As Range
Set argAccount = dataWS.Range("C:C")
Set argDocument = dataWS.Range("D:D")
Set argCurrency = dataWS.Range("G:G")
Set argAmType = dataWS.Range("R:R")
Set argAmount = dataWS.Range("Q:Q")
argAccCrit = 1100400
argTypeCrit = "*Comm*"
argTypeCritNot = "<>*Comm*"
pivotWS.Columns("J:M").VerticalAlignment = xlVAlignCenter
pivotWS.Columns("J:M").HorizontalAlignment = xlHAlignRight
pivotWS.Columns("J:M").ColumnWidth = 12
pivotWS.Cells(4, 10).Value = "PLN"
pivotWS.Cells(4, 11).Value = "PLN"
pivotWS.Cells(4, 12).Value = "EUR"
pivotWS.Cells(4, 13).Value = "EUR"
pivotWS.Cells(5, 9).Value = "X001a"
pivotWS.Cells(6, 9).Value = "X002a"
pivotWS.Cells(7, 9).Value = "X003a"
pivotWS.Cells(8, 8).Value = "xTOBI"
pivotWS.Cells(8, 9).Value = "X004a"
pivotWS.Cells(9, 9).Value = "X004a_TOBI"
pivotWS.Cells(10, 8).Value = "xTOBI"
pivotWS.Cells(10, 9).Value = "X004c"
pivotWS.Cells(11, 9).Value = "X004c_TOBI"
pivotWS.Cells(12, 9).Value = "X004e"
pivotWS.Cells(13, 9).Value = "X004i"
For r = 5 To 13
For c = 10 To 13
sumAmount = 0
If c = 10 Or c = 12 Then
argDocCrit = pivotWS.Cells(r, 9).Value
argCurrCrit = pivotWS.Cells(4, c).Value
For i = 2 To lastRow
If InStr(1, dataWS.Cells(i, 3).Value, "1100400") > 0 And InStr(1, dataWS.Cells(i, 4).Value, argDocCrit) > 0 And InStr(1, dataWS.Cells(i, 7).Value, argCurrCrit) > 0 _
And (InStr(1, dataWS.Cells(i, 18).Value, "GPW") > 0 Or InStr(1, dataWS.Cells(i, 18).Value, "Prem") > 0) Then
sumAmount = sumAmount + dataWS.Cells(i, 17).Value
End If
Next
pivotWS.Cells(r, c).NumberFormat = "#,##0.00"
pivotWS.Cells(r, c).Value = sumAmount
Else
argDocCrit = pivotWS.Cells(r, 9).Value
argCurrCrit = pivotWS.Cells(4, c).Value
For i = 2 To lastRow
If InStr(1, dataWS.Cells(i, 3).Value, "1100400") > 0 And InStr(1, dataWS.Cells(i, 4).Value, argDocCrit) > 0 And InStr(1, dataWS.Cells(i, 7).Value, argCurrCrit) > 0 _
And ((InStr(1, dataWS.Cells(i, 18).Value, "GPW") = 0 Or InStr(1, dataWS.Cells(i, 18).Value, "Prem") = 0) And InStr(1, dataWS.Cells(i, 18).Value, "Comm") > 0) Then
sumAmount = sumAmount + dataWS.Cells(i, 17).Value
End If
Next
pivotWS.Cells(r, c).NumberFormat = "#,##0.00"
pivotWS.Cells(r, c).Value = sumAmount
End If
Next
Next
For g = 1 To 20
If InStr(1, salesWS.Cells(g, 2).Value, "X004a") > 0 And InStr(1, salesWS.Cells(g, 3).Value, "TOBI", 1) > 0 And InStr(1, salesWS.Cells(g, 4).Value, "PLN") > 0 Then
pivotWS.Cells(9, 10).Value = salesWS.Cells(g, 5).Value
pivotWS.Cells(9, 11).Value = -Abs(salesWS.Cells(g, 7).Value)
End If
If InStr(1, salesWS.Cells(g, 2).Value, "X004a") > 0 And InStr(1, salesWS.Cells(g, 3).Value, "TOBI", 1) > 0 And InStr(1, salesWS.Cells(g, 4).Value, "EUR") > 0 Then
pivotWS.Cells(9, 12).Value = salesWS.Cells(g, 5).Value
pivotWS.Cells(9, 13).Value = -Abs(salesWS.Cells(g, 7).Value)
End If
If InStr(1, salesWS.Cells(g, 2).Value, "X004c") > 0 And InStr(1, salesWS.Cells(g, 3).Value, "TOBI", 1) > 0 And InStr(1, salesWS.Cells(g, 4), "PLN") > 0 Then
pivotWS.Cells(11, 10).Value = salesWS.Cells(g, 5).Value
pivotWS.Cells(11, 11).Value = -Abs(salesWS.Cells(g, 7).Value)
End If
If InStr(1, salesWS.Cells(g, 2).Value, "X004c") > 0 And InStr(1, salesWS.Cells(g, 3).Value, "TOBI", 1) And InStr(1, salesWS.Cells(g, 4).Value, "EUR") > 0 Then
pivotWS.Cells(11, 12).Value = salesWS.Cells(g, 5).Value
pivotWS.Cells(11, 13).Value = -Abs(salesWS.Cells(g, 7).Value)
End If
Next
pivotWS.Cells(8, 8).Value = ""
pivotWS.Cells(10, 8).Value = ""
pivotWS.Cells(8, 9).Value = "X004a_xTOBI"
pivotWS.Cells(10, 9).Value = "X004c_xTOBI"
pivotWS.Activate
wbName = "AccountancyReport"
ActiveWorkbook.SaveAs ("C:\dagama\" & wbName), FileFormat:=51
ActiveWorkbook.Save
'Workbooks("data_merged").Close SaveChanges:=True
Set dataWS = Nothing
Set pivotWS = Nothing
Set salesWS = Nothing
End Sub
Sub CopyOutput()
Dim wb1 As Workbook
'Dim wb2 As Workbook
Set wb1 = ActiveWorkbook
Sheets.Add.Name = "SalesIncomeCheck"
'Sheets.Add.Name = "SalesIncomeCheckCSV"
Dim strFile As String
strFile = "C:\dagama\SalesIncomeCheck.csv"
If FileExists(strFile) Then
Workbooks.OpenText "C:\dagama\SalesIncomeCheck.csv", Local:=True
ActiveWorkbook.Sheets(1).Range("A1:G16").Copy Destination:=wb1.Worksheets("SalesIncomeCheck").Cells
Workbooks("SalesIncomeCheck").Close SaveChanges:=False
End If
'Set wb2 = Workbooks.Open("C:\dagama\SalesCSVtoXLS.xlsx")
'wb2.Sheets(1).Range("A1:G17").Copy Destination:=wb1.Worksheets("SalesIncomeCheck").Cells
wb1.Activate
Columns("A:G").Select
Selection.EntireColumn.AutoFit
'wb2.Close SaveChanges:=False
'Set wb2 = Nothing
Set wb1 = Nothing
End Sub
Function FileExists(FilePath As String) As Boolean
Dim TestStr As String
TestStr = ""
On Error Resume Next
TestStr = Dir(FilePath)
On Error GoTo 0
If TestStr = "" Then
FileExists = False
Else
FileExists = True
End If
End Function