Really messed up Excel exports from financial software

[keizerkarel]

Hello,

We use accounting software from a big, reputable vendor. They offer Excel exports, but really don't know how to make them proper. What it looks like is shown below. The problem is the multiple-row layout.

How would I go about to fix this to a normal structure of 1 entry per row? It's not really possible to recreate this with the forum tables, and I'm not allowed to post attachments, so I tried to make it as clear as possible below. Screenshot is the current situation, table below is the ideal scenario:

Problem

Solution


[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Description[/TD]
[TD]Invoice Number[/TD]
[TD]Type[/TD]
[TD]Order Number[/TD]
[TD]Discount[/TD]
[TD]Ordered by[/TD]
[TD]Discount date[/TD]
[TD]Invoice for[/TD]
[TD]Value[/TD]
[TD]Amount[/TD]
[TD]Invoice Date[/TD]
[TD]File[/TD]
[TD]Track status[/TD]
[/TR]
[TR]
[TD]Description for invoice 1[/TD]
[TD]I20180001[/TD]
[TD]Normal[/TD]
[TD]O20180001[/TD]
[TD]0,00[/TD]
[TD]O000001[/TD]
[TD][/TD]
[TD]O000001[/TD]
[TD]Eur[/TD]
[TD]123456,78[/TD]
[TD]05-11-2018[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

Thanks in advance!!!

 

[ZVI]

Hi,
Try this macro:

Sub MessDataToPlainTable()
'ZVI:2018-11-10 https://www.mrexcel.com/forum/excel-questions/1076955-really-messed-up-excel-exports-financial-software.html
 
  ' Variables
  Dim a(), b()
  Dim rn(1 To 12) As Long, cn(1 To 12) As Long
  Dim i As Long, c As Long, r As Long
 
  ' Get the last row with data
  i = Columns("B").Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByRows, _
                   SearchDirection:=xlPrevious, SearchFormat:=False).Row
 
  ' Copy mess data into the input array a()
  a() = Range("A13").Resize(i - 11, 10).Value
 
  ' Create the ouput array b()
  ReDim b(1 To 1 + UBound(a) / 2, 1 To 12)
 
  ' Fill the output titles and prepare relative index arrays
  '     Title                 RowNum        ColNum
  b(1, 1) = "Description":    rn(1) = 2:    cn(1) = 1
  b(1, 2) = "Invoice Number": rn(2) = 1:    cn(2) = 2
  b(1, 3) = "Type":           rn(3) = 1:    cn(3) = 3
  b(1, 4) = "Order number":   rn(4) = 1:    cn(4) = 4
  b(1, 5) = "Discount":       rn(5) = 2:    cn(5) = 4
  b(1, 6) = "Ordered by":     rn(6) = 1:    cn(6) = 5
  b(1, 7) = "Discount date":  rn(7) = 2:    cn(7) = 5
  b(1, 8) = "Invoice for":    rn(8) = 1:    cn(8) = 7
  b(1, 9) = "Value":          rn(9) = 2:    cn(9) = 7
  b(1, 10) = "Amount":        rn(10) = 2:   cn(10) = 8
  b(1, 11) = "File":          rn(11) = 1:   cn(11) = 9
  b(1, 12) = "Track status":  rn(12) = 1:   cn(12) = 10
 
  ' Copy data from a() to b()
  i = 0
  For r = 2 To UBound(b)
    For c = 1 To UBound(b, 2)
      b(r, c) = a(i + rn(c), cn(c))
    Next
    i = i + 2
  Next
 
  ' Prevent blinking
  Application.ScreenUpdating = False
 
  ' Find/Create the output sheet and select it
  On Error Resume Next
  Sheets("PlainTable").Select
  If Err Then
    With Sheets.Add
      .Select
      .Name = "PlainTable"
    End With
  Else
    Sheets("PlainTable").UsedRange.ClearContents
  End If
  On Error GoTo 0
 
  ' Paste plain data to the output sheet and format cells
  With Sheets("PlainTable").Range("A1").Resize(UBound(b), UBound(b, 2))
    .Value = b()
    .Rows(1).Font.Bold = True
    .Rows(1).BorderAround Weight:=xlThin
    .Rows(1).Borders(xlInsideVertical).Weight = xlThin
    .Columns.AutoFit
    .Range("C2").Select
    ActiveWindow.FreezePanes = True
  End With
 
  ' Return screen updating
  Application.ScreenUpdating = True
 
End Sub

Regards