Hi all,
I want to extract data from notepad. I got one code from this forum and used in our requirement.
I have one issue while extracting the data using that code like -
When data is in multi-line it is not extracting that whole data it is only extracting only one line.
Please review below code and suggest. how can i extract invoice no.
Below is data -
Trading Par: WWW 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: ABC1 Company1
Supplier Number: 12345
Site: 004-SAN FRANCIS SAN FRANCISCO CA
031820008R 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%
Below is code -
Public Sub Import_Text_File()
On Error Resume Next
Dim dataFile As String
Dim fileLine As String, item As String, parts As Variant
Dim i As Long, n As Long
Dim dayData() As Variant
Dim TradingPar As String, SupplierNumber As String, Site As String, Ledger As String, total As String, _
endpoint As String, trading As String
endpoint = Sheet1.Range("G2").Value
'endpoint = Application.InputBox("Please enter end point", "End Point")
Dim dayReportDest As Range, dRow As Long
Dim arMyArray() As Variant
arMyArray = Sheet1.Range("A1").CurrentRegion.Value
arMyArray = Application.WorksheetFunction.Transpose(arMyArray)
dataFile = "C:\Users\manish.r.kuma\Desktop\DOPText\Ageing report past due dates_Detail_05042020.txt" 'CHANGE THIS FOLDER PATH AND FILE NAME
With Worksheets("PFI_CORE_USD_BOOK")
.Cells.Clear
.Range("A1:M1").Value = arMyArray
'.Range("A1:M1").Value = Array("TRADING PAR", "SUPPLIER NUMBER", "SITE", "INVOICE_NUMBER", _
"DUE_DATE", "DAYS_DUE", "UNPAID", "AMOUNT_REMAINING", "0-30_DAYS", "31-60_DAYS", "61-90_DAYS", "OVER_90_DAYS", "TOTAL")
Set dayReportDest = .Range("A2")
dRow = 0
End With
Open dataFile For Input As #1
n = 0
While Not EOF(1)
Line Input #1, fileLine
Debug.Print fileLine
item = GetItem(fileLine, "Trading Par: ")
If item <> "" Then TradingPar = item
item = GetItem(fileLine, "Supplier Number: ")
If item <> "" Then SupplierNumber = item
item = GetItem(fileLine, "Site: ")
If item <> "" Then Site = item
parts = Split(Application.WorksheetFunction.Trim(fileLine), " ")
If UBound(parts) = 8 Then
If IsNumeric(parts(0)) Or Not IsNumeric(parts(0)) Then
n = n + 1
ReDim Preserve dayData(1 To 13, 1 To n)
dayData(1, n) = TradingPar
dayData(2, n) = SupplierNumber
dayData(3, n) = Site
dayData(4, n) = parts(0)
dayData(5, n) = parts(1)
dayData(6, n) = parts(2)
dayData(7, n) = parts(3)
dayData(8, n) = parts(4)
dayData(9, n) = parts(5)
dayData(10, n) = parts(6)
dayData(11, n) = parts(7)
dayData(12, n) = parts(8)
End If
End If
item = GetItem(fileLine, endpoint) '------------End point------
Debug.Print item
If item <> "" Then
'If Ledger = "PFI_CORE_USD_BOOK" Then
For i = 1 To n
dayData(13, i) = item
Next
dayReportDest.Offset(dRow, 0).Resize(n, UBound(dayData)).Value = Application.Transpose(dayData)
dRow = dRow + n
n = 0
'End If
End If
Wend
Close #1
Sheet2.Columns.AutoFit
Range("A1").CurrentRegion.Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Font.Bold = True
Selection.Interior.Color = vbYellow
Range("A1").CurrentRegion.Borders.LineStyle = xlContinuous
Range("A1").Select
MsgBox "Data moved to excel"
End Sub
Private Function GetItem(text As String, item As String) As String
Dim p1 As Long, p2 As Long
GetItem = ""
p1 = InStr(text, item)
Debug.Print item
If p1 > 0 Then
p1 = p1 + Len(item)
p2 = InStr(p1, text, " ")
If p2 = 0 Then p2 = Len(text) + 1
GetItem = Mid(text, p1, p2)
Debug.Print GetItem
End If
End Function
I want to extract data from notepad. I got one code from this forum and used in our requirement.
I have one issue while extracting the data using that code like -
When data is in multi-line it is not extracting that whole data it is only extracting only one line.
Please review below code and suggest. how can i extract invoice no.
Below is data -
Trading Par: WWW 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: ABC1 Company1
Supplier Number: 12345
Site: 004-SAN FRANCIS SAN FRANCISCO CA
031820008R 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%
Below is code -
Public Sub Import_Text_File()
On Error Resume Next
Dim dataFile As String
Dim fileLine As String, item As String, parts As Variant
Dim i As Long, n As Long
Dim dayData() As Variant
Dim TradingPar As String, SupplierNumber As String, Site As String, Ledger As String, total As String, _
endpoint As String, trading As String
endpoint = Sheet1.Range("G2").Value
'endpoint = Application.InputBox("Please enter end point", "End Point")
Dim dayReportDest As Range, dRow As Long
Dim arMyArray() As Variant
arMyArray = Sheet1.Range("A1").CurrentRegion.Value
arMyArray = Application.WorksheetFunction.Transpose(arMyArray)
dataFile = "C:\Users\manish.r.kuma\Desktop\DOPText\Ageing report past due dates_Detail_05042020.txt" 'CHANGE THIS FOLDER PATH AND FILE NAME
With Worksheets("PFI_CORE_USD_BOOK")
.Cells.Clear
.Range("A1:M1").Value = arMyArray
'.Range("A1:M1").Value = Array("TRADING PAR", "SUPPLIER NUMBER", "SITE", "INVOICE_NUMBER", _
"DUE_DATE", "DAYS_DUE", "UNPAID", "AMOUNT_REMAINING", "0-30_DAYS", "31-60_DAYS", "61-90_DAYS", "OVER_90_DAYS", "TOTAL")
Set dayReportDest = .Range("A2")
dRow = 0
End With
Open dataFile For Input As #1
n = 0
While Not EOF(1)
Line Input #1, fileLine
Debug.Print fileLine
item = GetItem(fileLine, "Trading Par: ")
If item <> "" Then TradingPar = item
item = GetItem(fileLine, "Supplier Number: ")
If item <> "" Then SupplierNumber = item
item = GetItem(fileLine, "Site: ")
If item <> "" Then Site = item
parts = Split(Application.WorksheetFunction.Trim(fileLine), " ")
If UBound(parts) = 8 Then
If IsNumeric(parts(0)) Or Not IsNumeric(parts(0)) Then
n = n + 1
ReDim Preserve dayData(1 To 13, 1 To n)
dayData(1, n) = TradingPar
dayData(2, n) = SupplierNumber
dayData(3, n) = Site
dayData(4, n) = parts(0)
dayData(5, n) = parts(1)
dayData(6, n) = parts(2)
dayData(7, n) = parts(3)
dayData(8, n) = parts(4)
dayData(9, n) = parts(5)
dayData(10, n) = parts(6)
dayData(11, n) = parts(7)
dayData(12, n) = parts(8)
End If
End If
item = GetItem(fileLine, endpoint) '------------End point------
Debug.Print item
If item <> "" Then
'If Ledger = "PFI_CORE_USD_BOOK" Then
For i = 1 To n
dayData(13, i) = item
Next
dayReportDest.Offset(dRow, 0).Resize(n, UBound(dayData)).Value = Application.Transpose(dayData)
dRow = dRow + n
n = 0
'End If
End If
Wend
Close #1
Sheet2.Columns.AutoFit
Range("A1").CurrentRegion.Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Font.Bold = True
Selection.Interior.Color = vbYellow
Range("A1").CurrentRegion.Borders.LineStyle = xlContinuous
Range("A1").Select
MsgBox "Data moved to excel"
End Sub
Private Function GetItem(text As String, item As String) As String
Dim p1 As Long, p2 As Long
GetItem = ""
p1 = InStr(text, item)
Debug.Print item
If p1 > 0 Then
p1 = p1 + Len(item)
p2 = InStr(p1, text, " ")
If p2 = 0 Then p2 = Len(text) + 1
GetItem = Mid(text, p1, p2)
Debug.Print GetItem
End If
End Function
