Using VBA to clean up imported data

[capefear]

I receive data from an old system that does not format the data in a table format. It takes hours for me to clean up the data so I can use pivot tables, etc. to summarize the data. Does anyone know how to write VBA to do this automatically? I am new to VBA. Doing this manually takes hours. I would really appreciate some help. The data received looks like this:

SSDB example r1.xlsx
	A	B	C	D
1		Query Definition
2
3	Recipient:	My name
4	Query:	salestest (302306-1)
5	Period:	03/08-02/09
6	Results:	Volume[Kg],Sales[USD]
7	Break 1:	By Month
8	Break 2:	By Product
9	Break 3:	By Holding
10
11	Selections:
12	EG only
13
14	Product list
15	956910	ProductA
16	987322	ProductB
17
18	Month
19	ProdID	Product	Volume[Kg]	Sales[USD]
20	HdgID	Holding	12Mth-02/09	12Mth-02/09
21	----------------	--------------------------------	-------------	---------------
22	2008/03
23	----------------	--------------------------------
24	956910	ProductA
25	----------------	--------------------------------
26	106325	Cust A	10	100
27	109102	Cust B	50	500
28	111424	Cust C	12	150
29	119200	Cust D	5	180
30	================	================================	=============	===============
31	2008/03		77	930
32
33
34	2008/04
35	----------------	--------------------------------
36	956910	ProductA
37	----------------	--------------------------------
38	106325	Cust A	50	200
39	109102	Cust B	10	180
40	111424	Cust C	25	300
41	================	================================	=============	===============
42	956910	ProductA	85	680
43
44	987322	ProductB
45	----------------	--------------------------------
46	134000	Cust E	110	300
47	707500	Cust F	1975	2000
48	================	================================	=============	===============
49	987322	ProductB	2085	2300
50
51
52	================	================================	=============	===============
53	2008/04		2170	2980
54
55
56	2008/05
57	----------------	--------------------------------
58	956910	ProductA
59	----------------	--------------------------------
60	106325	Cust A	10	300
61	109102	Cust B	16	150
62	111424	Cust C	5	50
63	119200	Cust D	150	560
64	================	================================	=============	===============
65	956910	ProductA	181	1060
66
67	987322	ProductB
68	----------------	--------------------------------
69	109102	Cust B	130	250
70	111424	Cust C	5	20
71	119200	Cust D	570	1500
72	================	================================	=============	===============
73	987322	ProductB	705	1770
74
75
76	================	================================	=============	===============
77	2008/05		866	2830
78
79	================	================================	=============	===============
80	TOTAL		3133	6740
RAW DATA

I would like the data to look this:

SSDB example r1.xlsx
	A	B	C	D	E	F
1	Date	ProdID	Customer ID	Customer	Volume[Kg]	Sales[USD]
2	Feb-08	956910	106325	Cust A	10	100
3	Feb-08	956910	109102	Cust B	50	500
4	Feb-08	956910	111424	Cust C	12	150
5	Feb-08	956910	119200	Cust D	5	180
6	Apr-08	956910	106325	Cust A	50	200
7	Apr-08	956910	109102	Cust B	10	180
8	Apr-08	956910	111424	Cust C	25	300
9	Apr-08	987322	134000	Cust E	110	300
10	Apr-08	987322	707500	Cust F	1975	2000
11	May-08	956910	106325	Cust A	10	300
12	May-08	956910	109102	Cust B	16	150
13	May-08	956910	111424	Cust C	5	50
14	May-08	956910	119200	Cust D	150	560
15	May-08	987322	109102	Cust B	130	250
16	May-08	987322	111424	Cust C	5	20
17	May-08	987322	119200	Cust D	570	1500
Table

 

[Legacy 68668]

OK
1) Is the text file include quotaion marks ?
2) Can you tell me why Date is Feb-08 in your result, while your txt file shows
"Period:" "03/08-02/09"

 

[capefear]

Yes, the text file includes the quotes. The results file is incorrect. It should be Mar-08. Sorry, for that.

 

[Legacy 68668]

Let's see if this works for you.

Sub test()
Dim fn As String, temp As String, x
Dim i As Long, ii As Long, iii As Long
Dim a() As String
fn = "c:\test.txt"   '<- change here (File Path)
temp = CreateObject("Scripting.FileSystemObject").OpenTextFile(fn).ReadAll
temp = Replace(Replace(temp, "-", ""), "=", "")
x = Split(temp, vbCrLf)
ReDim a(1 To UBound(x), 1 To 6)
With CreateObject("VBScript.RegExp")
    .IgnoreCase = True
    .Pattern = "^\s*$"
    .MultiLine = True
    temp = .replace(temp, "")
    For i = 0 To UBound(x)
        .Pattern = "\s*""(\d{2}/\d{2})""\s*$"
        .MultiLine = False
        If .test(x(i)) Then
            n = n + 1 : ii = 0
            b(n, 1) = DateValue(.execute(x(i)).(0).submatches(0) & "/1")
            .Pattern = """([^""])+""\s+""[^""]+""\s*$"
            Do
                ii = ii + 1
                If .test(x(i + ii)) Then Exit Do
                If i + ii > UBound(x) Then GoTo myEnd
            Loop
            iii = 0
            ProdID = .execute(x(i + ii))(0).subamtches(0) : iii = 1
            .Pattern = """(\d+)""\s+""([^""])+""\s+(\d*(\.\d+)?)\s+(\d(\.\d+)?)\s*$"
            Do While .test(x(i + ii + iii))
                Set m = .execute(x(i + ii + iii))(0)
                n = n + 1
                a(n, 1) = myDate : a(n, 2) = ProdID
                a(n, 3) = m.submatches(0)
                a(n, 4) = m.submatches(1)
                a(n, 5) = m.submatches(2)
                a(n, 6) = m.submatches(4)
            Loop
            i = i + ii + iii - 1
        End If
    Next
End With
With ThisWorkbook.Sheets(1).Cells(1)
    .Resize(, 6).Value = [{"Date","ProdID","CustomerID","Customer","Volume[Kg]","Sales[USD]"}]
    .Offset(1).Resize(n, 6).Value = a
End With
End Sub

 

[capefear]

Wow! Thanks! Unfortunately, I received a compile: syntax error when I pasted the code into vba for line:
b(n, 1) = DateValue(.execute(x(i)).(0).submatches(0) & "/1")