Splitting large range of data into multiple cost center outputs in txt-format

[RAECH]

Hi Everyone

I need to split a large range of data from approx. 950 different cost centres into a text-file for each cost centre. I need to extract the data from each account and posting period on each of our cost centre into - so that it can be uploaded into our ERP.

My data looks like this:






Posting period
Oct
Nov
Dec
Jan






ActualsYTDZ42020
ActualsYTDZ42020
ActualsYTDZ42020
ActualsYTDZ42020


Cost center
0
Account No.

* 1.000
* 1.000
* 1.000
* 1.000


10000
General Group HQ
5500
Cons, Packaging
0
0
1,37573
0


10000
General Group HQ
6000
Salary
436,8968
424,9079
402,8012
453,2055


10000
General Group HQ
6003
Pension
34,95174
33,99263
32,2241
37,14348


10001
The house of Hennevej
6527
Electrical items
0
0
1,94516
2,81275


10001
The house of Hennevej
6528
Lubric oil & grease
0,3079
0,37291
0
0


10003
Group HR
6018
Ref wage/unempl. all
0
0
0
0


10005
Visitors Horsens
6570
Roadtax
0
0
0
2,19



I have various amounts of account numbers for each cost center. The text file I need to generate start with something like this:
Where for each generated text file, it writes the cost center in the "header". The account numbers goes in "Cost Element" and each posting period corresponding to period 1-12 in below set-up.



Version
Z87














Fiscal Year
2021














Cost Center
10000
















1
2
3
4
5
6
7
8
9
10
11
12


Cost element

Period 1
Period 2
Period 3
Period 4
Period 5
Period 6
Period 7
Period 8
Period 9
Period 10
Period 11
Period 12



I am aware that is probably is a big tasks.. And something that takes a long time to run. In total I have 10190 account lines that I need to split up on cost centres.

I have tried a few different things - for example codes similar to below.. Which I to some extent can make work - but probably is not the best way to do this..


a = 0For a = 0 To 100
If ActiveCell.Value = "" Then Exit For
ActiveCell.Offset(0, 2).Resize(1, 14).Copy
ActiveCell.Offset(0, 20).PasteSpecial xlPasteValues
Application.CutCopyMode = False
ActiveCell.Offset(1, -20).Activate


But in this task from my employer I really am out of my league.. So I hope that someone can put me in the right direction - as I would also like to learn how a proper set up for something like this could be.

Best regards
Rasmus

[snb]

No file, no answer.

[RAECH]

Sorry. Here is an example file.

I needed to trim the data down - so I removed a lot of our cost centers.

I hope it is still enough to get some help.

[p45cal]

There's a wide variety of text file formats, best if you attach a sample output text file that will work with your ERP.

[RAECH]

I'm not allowed to upload a .txt-file.

But it has the template as shown in the post. (and output sheet in the before attached Excel-file)

I need the file saved as "Text (Tab delimited) (*.txt)"

[p45cal]

I'm not allowed to upload a .txt-file.

Change its extension manually to .zip and upload.

[snb]

Sub M_snb()
With CreateObject("scripting.filesystemobject")
.createtextfile("G:\OF\test_9.csv").write Replace(.opentextfile("G:\OF\test_9.csv").readall, ",", "|")
End With
End Sub

[RAECH]

Change its extension manually to .zip and upload.

[SamT]

I would start by creating an Excel Database Workbook of Cost Centers, one CC per sheet. that will make it easier to convert each sheet to a txt file and: will make it easier to run many of Excel's Business Intelligence Functions.
Thew
following Compiles, but is not tested
Option Explicit

Dim CostCenters As Workbook


Sub To_Set_CostCenters_To_NewWorkbook()
'Needs Code to add/open empty Workbook:
End Sub


Sub SplitCostCentersIntoSheets()
Dim LastColumn As Long
Dim FirstCell As Range, lastCell As Range, CostCenterGroup As Range
Dim Sht As Worksheet
Dim Headers As Variant
Dim StatBar

With Application
.DisplayAlerts = False
.ScreenUpdating = False
StatBar = .DisplayStatusBar
.DisplayStatusBar = True
End With

LastColumn = RealLastColumn
Headers = GetHeaders

With Sheets("CostCenter")
Set FirstCell = .Range("A5")
Do While FirstCell.Value <> ""
DoEvents 'Enables Breaks while running. Slows execution.
Application.StatusBar = "Working on Cost Center " & FirstCell.Value
'Setup CostCenters Sheet
With Workbooks("CostCenters")
.Worksheets.Add
.Sheets(Sheets.Count).Name = "CC_" & FirstCell.Value
With .Sheets("CC_" & FirstCell.Value)
.Range("A1") = "Version"
.Range("A2") = "Fiscal Year"
.Range("A3") = "Cost Center"
.Range("A5") = "Account Number"
.Range("B1") = "Z87"
.Range("B2") = 2021
.Range("B3") = FirstCell.Value
.Range("C4").Resize(2, UBound(Headers, 2)) = Headers
End With 'Sheets
End With 'Workbooks
'Setup CostCenterGroup
Set lastCell = .Range("A:A").Find(What:=FirstCell, After:=FirstCell, SearchDirection:=xlPrevious)
Set CostCenterGroup = .Range(FirstCell.Offset(, 2), Cells(lastCell.Row, LastColumn))
'Copy Data to new Sheet
CostCenterGroup.Copy Workbooks("CostCenters").Sheets("CC_" & FirstCell.Value).Range("A5")
Set FirstCell = lastCell
Loop
End With 'sheets

With Application
.StatusBar = False
.DisplayStatusBar = StatBar
.DisplayAlerts = True
.ScreenUpdating = True
End With

End Sub


Private Function GetHeaders() As Variant
GetHeaders = Sheets("Cost Center").Range(Cells(2, "D"), Cells(3, RealLastColumn)).Value
End Function



Private Function RealLastColumn() As Long
Dim LastFormula As Range
Dim LastValue As Range


With Worksheets("Cost Center")
On Error Resume Next
Set LastFormula = .Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious)
Set LastValue = .Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious)
On Error GoTo 0
End With

If LastFormula Is Nothing And LastValue Is Nothing Then
RealLastColumn = 1
Exit Function
End If

RealLastColumn = Application.WorksheetFunction.Max(LastFormula.Column, LastValue.Column)
End Function

[p45cal]

In the attached, which is a test, I've set up a pivot table at cell K2, where I've got the Account no. on the left but renamed that column Cost Element, as well as renaming the Oct to Feb columns Period 1, Period 2 etc.
There's a neat function with pivot tables where you can create new sheets en masse by doing the following:
Select any cell in the pivot, go to the ribbon and on the PivotTable Analyze tab, in the PivotTable section, you have an Options drop down where you select Show Report Filter Pages… A dialogue pops up and you confirm with OK.
Either do this, or Button 1 at cell N1 does it for you.
Now you can see the addition of loads of new sheets.
Back on the Cost Center sheet there's Button 2, below Button 1 which you should click.
Are the resulting text files (in the same folder as the Excel file) correct?

[RAECH]

THANK YOU GUYS!

This is very helpful - I will take a look at both solution and see how they work. But for now, I believe for sure that I make this work for my problem :-)

p45cal: Smart solution using the pivot to split up the cost centers. Never thought of that.
The text files are actually going into a subfolder so we can select out "output files"-folder when we upload everything to the system. So I would at least change this in the code.

[snb]

A typical Dictionary question:


Sub M_snb()
sn = Sheet4.UsedRange
ReDim sp(100, 13)

sp(0, 0) = "Version"
sp(1, 0) = "Fiscal Year"
sp(1, 1) = 2021
sp(2, 0) = "Cost Center"
For j = 1 To 12
sp(4, 1 + j) = j
Next

With CreateObject("scripting.dictionary")
For j = 5 To UBound(sn)
x0 = .Item(sn(j, 1))
Next

n=4
For j = 0 To .Count - 1
st = sp
st(2, 1) = .Keys()(j)
For jj = n To UBound(sn)
If sn(jj, 1) <> st(2, 1) Or IsEmpty(sn(jj, 1)) Then Exit For
st(5 + jj - n, 0) = sn(jj, 3)
For jjj = 5 To UBound(sn, 2)
st(5 + jj - n, jjj - 3) = sn(jj, jjj)
Next
Next
n = jj

Sheets.Add(, Sheets(Sheets.Count)).Cells(1).Resize(UBound(st) + 1, UBound(st, 2) + 1) = st
Next

End With
End Sub