Extract data from txt file

[Mankum]

Hi All,

I have a data in txt file. could anyone please help me in extracting data from txt file to excel.

In below table one of the column(Header data) may be blank.

below is structure of my data -

"
Ledger: PFI_CORE_USD_BOOK Report Date: 28-APR-2020 17:10
Operating Unit: PFI Domestic Page: 2
Invoice Aging Report

Invoice Voucher Due Days % Amount 0-30 Days 31-60 Days 61-90 Days Over 90 Days
Number Number Date Due Unpaid Remaining
------------- ---------- --------- ------ -------- --------------- --------------- --------------- --------------- ---------------
Trading Par: ABC Company1
Supplier Number: 12345
Site: 004-SAN FRANCIS SAN FRANCISCO CA

031820008 18-MAR-20 41 100.0 348,887.68 0.00 348,887.68 0.00 0.00
--------------- ------------------------------ --------------- ---------------
Total: 348,887.68 0.00 348,887.68 0.00 0.00
0% 100% 0% 0%

Trading Par: ABC Company2
Supplier Number: 11234
Site: HOME

PFI2841828 24-SEP-18 582 100.0 -118.45 0.00 0.00 0.00 -118.45
--------------- ------------------------------ --------------- ---------------
Total: -118.45 0.00 0.00 0.00 -118.45
0% 0% 0% 100%

Trading Par: ABC Company3
Supplier Number: 100600
Site: 008-CHICAGO CHICAGO IL

BLS- 08-SEP-19 233 100.0 7,500.00 0.00 0.00 0.00 7,500.00
SAMDECCL19PRD
--------------- ------------------------------ --------------- ---------------
Total: 7,500.00 0.00 0.00 0.00 7,500.00
0% 0% 0% 100%

Trading Par: ABC Company4
Supplier Number: 119900
Site: 002-HICKSVILLE HICKSVILLE NY .TEL 822-6230

APPS 7-19 30-AUG-19 242 100.0 152.80 0.00 0.00 0.00 152.80
Shirley_Willi
ams
2003313640 31-MAR-20 28 100.0 28,181.53 28,181.53 0.00 0.00 0.00
--------------- ------------------------------ --------------- ---------------
Total: 28,334.33 28,181.53 0.00 0.00 152.80
99% 0% 0% 1%

Trading Par: ABC Company5
Supplier Number: 500123
Site: HOME

PFI3539066 08-JUL-19 295 100.0 -8.00 0.00 0.00 0.00 -8.00
--------------- ------------------------------ --------------- ---------------
Total: -8.00 0.00 0.00 0.00 -8.00
0% 0% 0% 100%

Trading Par: ABC Company6
Supplier Number: 101192
Site: 001-PHILADELPHI PHILADELPHIA PA

100000889012- 06-APR-20 22 100.0 811,679.40 811,679.40 0.00 0.00 0.00
2020
--------------- ------------------------------ --------------- ---------------
Total: 811,679.40 811,679.40 0.00 0.00 0.00
100% 0% 0% 0%
Ledger: PFI_CORE_USD_BOOK Report Date: 28-APR-2020 17:10
Operating Unit: PFI Domestic Page: 3
Invoice Aging Report

Invoice Voucher Due Days % Amount 0-30 Days 31-60 Days 61-90 Days Over 90 Days
Number Number Date Due Unpaid Remaining
------------- ---------- --------- ------ -------- --------------- --------------- --------------- --------------- ---------------
Trading Par: ABC Company7
Supplier Number: 110098
Site: 008-NEWARK NEWARK NJ

266693R 05-DEC-19 145 100.0 68,888.02 0.00 0.00 0.00 68,888.02
1047 14-DEC-19 136 100.0 96,445.70 0.00 0.00 0.00 96,445.70
1048 14-DEC-19 136 100.0 13,726.17 0.00 0.00 0.00 13,726.17
266862 14-DEC-19 136 100.0 3,341.37 0.00 0.00 0.00 3,341.37
1049 17-JAN-20 102 100.0 33,118.48 0.00 0.00 0.00 33,118.48
267840 20-FEB-20 68 100.0 77,929.86 0.00 0.00 77,929.86 0.00
1061 16-MAR-20 43 100.0 530,813.91 0.00 530,813.91 0.00 0.00
1071 16-MAR-20 43 100.0 1,079,488.29 0.00 1,079,488.29 0.00 0.00
--------------- ------------------------------ --------------- ---------------
Total: 1,903,751.80 0.00 1,610,302.20 77,929.86 215,519.74
0% 85% 4% 11%

I want below data in excel -

Trading Par

Supplier Number

Site

INVOICE_NUMBER

VOUCHER_NUMBER

DUE_DATE

DAYS_DUE

UNPAID

AMOUNT_REMAINING

0-30_DAYS

31-60_DAYS

61-90_DAYS

OVER_90_DAYS

"

Please help me in this.

 

[DanteAmor]

Your data on the notepad looks like this:

You could put those examples above on an excel sheet to see how you want them.
Use the XL2BB tool to put the example here.

 

[Mankum]

 

[Mankum]

Hi sir,

My data would be in above format, and i need it as below format in excel

Please provide solution..

 

[DanteAmor]

Please provide solution..

I'm happy to help you, but you're changing the information and that doesn't help.

You could upload a couple of files to the cloud.
The txt file and the excel file with the columns filled with the txt data.

In your first example you have company7 with several records, in that case how the excel file should be filled.
Also put that record in the files.

You could upload a copy of your file to a free site such www.dropbox.com or google drive. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. If the workbook contains confidential information, you could replace it with generic data.

 

[Mankum]

Thanks to all...I got the answer

Option Explicit
Option Base 1


Sub try()
On Error Resume Next

Dim arr1() As Variant
Dim arr2() As Variant

Dim arr3() As Variant
Dim arr4() As Variant

Dim lastrow1 As Long
Dim lastcol1 As Long

Dim lastrow2 As Long
Dim lastcol2 As Long

lastrow1 = Sheet1.Range("A" & Rows.Count).End(xlUp).Row '------lastrow count for sheet1
lastcol1 = Sheet1.Cells(1, Columns.Count).End(xlToLeft).Column ' ------last header count for sheet1

lastrow2 = Sheet2.Range("A" & Rows.Count).End(xlUp).Row '------lastrow count for sheet2
lastcol2 = Sheet2.Cells(1, Columns.Count).End(xlToLeft).Column '------last header count for sheet2

Dim i As Integer, pos1 As Long, pos2 As Long
'-----data row
ReDim arr1(lastrow1 - 1) As Variant '----for row sheet1
ReDim arr2(lastrow2 - 1) As Variant '----for row sheet2

ReDim arr3(lastcol1 - 1) As Variant '----for col sheet1
ReDim arr4(lastcol2 - 1) As Variant '----for col sheet2

For i = 2 To lastrow1

arr1(i - 1) = Sheets(1).Cells(i, 1).Value

Next i

For i = 2 To lastrow2

arr2(i - 1) = Sheets(2).Cells(i, 1).Value

Next i

'-----header

For i = 2 To lastcol1

arr3(i - 1) = Sheets(1).Cells(1, i).Value

Next i

For i = 2 To lastcol2

arr4(i - 1) = Sheets(2).Cells(1, i).Value

Next i

Dim j As Integer

For i = 2 To lastrow1 '----data row
pos1 = 0

pos1 = Application.Match(arr1(i - 1), arr2, False)
If pos1 <> 0 Then


For j = 2 To lastcol1 '----header
pos2 = 0

pos2 = Application.Match(arr3(j - 1), arr4, False)
If pos2 <> 0 Then

If Sheet1.Cells(i, j).Value <> Sheet2.Cells(pos1 + 1, pos2 + 1).Value Then

Sheet2.Cells(pos1 + 1, pos2 + 1).Interior.Color = vbCyan
End If




End If
Next j

End If
Next i


'-------------Status update


Sheet2.Cells(1, lastcol2 + 1).Value = "Status"
For i = 2 To lastrow1 '----data row
pos1 = 0

pos1 = Application.Match(arr1(i - 1), arr2, False)
If pos1 <> 0 Then


For j = 2 To lastcol1 '----header
pos2 = 0

pos2 = Application.Match(arr3(j - 1), arr4, False)
If pos2 <> 0 Then

If Sheet2.Cells(pos1 + 1, pos2 + 1).Interior.Color = vbCyan Then

Sheet2.Cells(pos1 + 1, lastcol2 + 1).Value = "Not Match"
Sheet2.Cells(pos1 + 1, lastcol2 + 1).Interior.Color = vbRed
Exit For
Else
Sheet2.Cells(pos1 + 1, lastcol2 + 1).Value = "Match"
Sheet2.Cells(pos1 + 1, lastcol2 + 1).Interior.Color = vbYellow
End If




End If
Next j

End If
Next i

End Sub


============via loop=========

Option Explicit
Sub matchdata()
Dim mrow As Integer
Dim srow As Integer
Dim lastRow As Integer
Dim Prow As Integer
Dim mmrow As Integer
Dim ssrow As Integer
Dim header1 As Integer
Dim header2 As Integer
Dim head1 As Integer
Dim head2 As Integer
Sheet2.Range("F:F").Offset(0).Clear
Sheet2.Range("F1").Value = "Status"

lastRow = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
srow = Sheet2.Range("A" & Rows.Count).End(xlUp).Row
header1 = Sheet1.Cells(1, Columns.Count).End(xlToLeft).Column
header2 = Sheet2.Cells(1, Columns.Count).End(xlToLeft).Column

'MsgBox header1 & "-----1-----2---" & header2
'MsgBox srow
For Prow = 2 To lastRow
For mmrow = 2 To srow


If Sheet1.Range("A" & Prow).Value = Sheet2.Range("A" & mmrow).Value Then
'-----for header match
For head1 = 2 To header1
For head2 = 2 To header2
If Sheet1.Cells(1, head1).Value = Sheet2.Cells(1, head2).Value Then
MsgBox Sheet1.Cells(1, head1).Value & "-----" & Sheet2.Cells(1, head2).Value
ssrow = Sheet2.Cells(1, Columns.Count).End(xlToLeft).Column
'MsgBox Sheet1.Range("A" & Prow).Value & "--" & Sheet2.Range("A" & mmrow).Value
If Sheet1.Cells(Prow, head1).Value <> Sheet2.Cells(mmrow, head2).Value Then
Sheet2.Cells(mmrow, head2).Interior.Color = vbCyan
End If


' For mrow = 2 To ssrow
' 'if Sheet2.Range("A" & mmrow).Offset(0, mrow - 1).Value = Sheet1.Range("A" & Prow).Offset(0, mrow - 1).Value Then
' If Sheet1.Range("A" & Prow).Offset(0, mrow - 1).Value <> Sheet2.Range("A" & mmrow).Offset(0, mrow - 1).Value Then
' 'MsgBox Sheet2.Range("A" & mmrow).Offset(0, mrow).Address & "-----" & Sheet1.Range("A" & Prow).Offset(0, mrow).Address
' Sheet2.Range("A" & mmrow).Offset(0, mrow - 1).Interior.Color = vbCyan
'
' End If
' Next mrow
End If

Next head2
Next head1
End If
Next mmrow


Next Prow

'--------Updating status-------------

For Prow = 2 To lastRow
For mmrow = 2 To srow


If Sheet1.Range("A" & Prow).Value = Sheet2.Range("A" & mmrow).Value Then
ssrow = Sheet1.Cells(1, Columns.Count).End(xlToLeft).Column
'MsgBox Sheet1.Range("A" & Prow).Value & "--" & Sheet2.Range("A" & mmrow).Value
For mrow = 2 To ssrow
'if Sheet2.Range("A" & mmrow).Offset(0, mrow - 1).Value = Sheet1.Range("A" & Prow).Offset(0, mrow - 1).Value Then
If Sheet2.Range("A" & mmrow).Offset(0, mrow - 1).Interior.Color = vbCyan Then
'MsgBox Sheet2.Range("A" & mmrow).Offset(0, mrow).Address & "-----" & Sheet1.Range("A" & Prow).Offset(0, mrow).Address
'Sheet2.Cells(2, ssrow + 1).Value = "Not Matched"
Sheet2.Range("F" & mmrow).Value = "Not matched"
Sheet2.Range("F" & mmrow).Interior.Color = vbRed
Exit For
Else
Sheet2.Range("F" & mmrow).Value = "Matched"
Sheet2.Range("F" & mmrow).Interior.Color = vbGreen
End If

Next mrow

End If
Next mmrow


Next Prow

End Sub