Notepad data extraction

M

Mankum

New Member
Joined
May 4, 2020
Messages
28
Office Version
  1. 365
VBA Code: 
Option Explicit

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 reportDate As String, TradingPar As String, SupplierNumber As String, Site As String, Ledger As String, total As String, _
        endpoint As String, trading As String
        endpoint = "Total:" 'Sheet1.Range("G2").Value
    Dim dayReportDest As Range, dRow As Long
    Dim arMyArray() As Variant
    arMyArray = ThisWorkbook.Sheets("Config").Range("A1").CurrentRegion.Value
    arMyArray = Application.WorksheetFunction.Transpose(arMyArray)
   
    Dim input_txt As String
   input_txt = ThisWorkbook.Sheets("Home").Range("F9").Value
    '----CHANGE THIS FOLDER PATH AND FILE NAME-----
    dataFile = input_txt
       
    With Worksheets("Past due date")
        '.Cells.Clear
        .Range("A1:O1").Value = arMyArray
        Set dayReportDest = .Range("A2")
        dRow = 0
     .Range("E1").EntireColumn.NumberFormat = "@"
       
    End With
   ' Exit Sub

    Open dataFile For Input As #1
   
    n = 0
   
    While Not EOF(1)
   
        Line Input #1, fileLine
        'Debug.Print fileLine
       
        item = GetItem(fileLine, "Report Date: ")
        If item <> "" Then reportDate = item
       
        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 15, 1 To n)
                dayData(1, n) = reportDate
                dayData(2, n) = TradingPar
                dayData(3, n) = SupplierNumber
                dayData(4, n) = Site
                dayData(5, n) = parts(0)
                dayData(6, n) = parts(1)
                dayData(7, n) = parts(2)
                dayData(8, n) = parts(3)
                dayData(9, n) = parts(4)
                dayData(10, n) = parts(5)
                dayData(11, n) = parts(6)
                dayData(12, n) = parts(7)
                dayData(13, n) = parts(8)
            End If
           
         ElseIf UBound(parts) = 0 Then
                ReDim Preserve dayData(1 To 1, 1 To n)
                dayData(5, n) = dayData(5, n) & parts(0)
             
        ElseIf UBound(parts) = 1 Then
                ReDim Preserve dayData(1 To 1, 1 To n)
                dayData(5, n) = dayData(5, n) & parts(0) & " " & parts(1)

        ElseIf UBound(parts) = 2 Then
                ReDim Preserve dayData(1 To 1, 1 To n)
                dayData(5, n) = dayData(5, n) & parts(0) & " " & parts(1) & " " & parts(2)
             
             
         ElseIf UBound(parts) = 9 Then
            If IsNumeric(parts(0)) Or Not IsNumeric(parts(0)) Then
                n = n + 1
                ReDim Preserve dayData(1 To 15, 1 To n)
                dayData(1, n) = reportDate
                dayData(2, n) = TradingPar
                dayData(3, n) = SupplierNumber
                dayData(4, n) = Site
                dayData(5, n) = parts(0) & " " & parts(1)
                'dayData(5, n) = parts(0)
                'dayData(6, 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)
                dayData(13, n) = parts(9)

            End If
           
            '-------------for 11th part------------
        ElseIf UBound(parts) = 10 Then
            If IsNumeric(parts(0)) Or Not IsNumeric(parts(0)) Then
                n = n + 1
                ReDim Preserve dayData(1 To 15, 1 To n)
                dayData(1, n) = reportDate
                dayData(2, n) = TradingPar
                dayData(3, n) = SupplierNumber
                dayData(4, n) = Site
                dayData(5, n) = parts(0) & " " & parts(1) & " " & parts(2)
                'dayData(6, n) = parts(2)
                dayData(6, n) = parts(3)
                dayData(7, n) = parts(4)
                dayData(8, n) = parts(5)
                dayData(9, n) = parts(6)
                dayData(10, n) = parts(7)
                dayData(11, n) = parts(8)
                dayData(12, n) = parts(9)
                dayData(13, n) = parts(10)



            End If
       
        '-------------------------------------
           
           
          End If
       
        item = GetItem(fileLine, endpoint)  '------------End point------
        'Debug.Print item
       
        If item <> "" Then
            For i = 1 To n
                dayData(15, i) = item
            Next
            dayReportDest.Offset(dRow, 0).Resize(n, UBound(dayData)).Value = Application.Transpose(dayData)
            dRow = dRow + n
            n = 0
        End If
               
    Wend
   
    Close #1
   
    Call sheetFormatting
   
    
    Sheets("Past due date").Range("P1").EntireColumn.Clear
    Sheets("Past due date").Range("Q1").EntireColumn.Clear
    Sheets("Past due date").Range("R1").EntireColumn.Clear
   
    Call cleanData
    
     Sheets("Past due date").Range("N1").EntireColumn.Clear
     Sheets("Past due date").Range("O1").EntireColumn.Clear
    
   Call CopyPasteCol
   
   
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
'-----------------------


''------alfa

Option Explicit

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 endpoint As String
     Dim input_txt As String
    Dim dayReportDest As Range, dRow As Long
    Dim arMyArray() As Variant
   
   
    endpoint = Sheet1.Range("G2").Value '"[URL='http://www.alfagomma.com']www.alfagomma.com[/URL]"
    arMyArray = ThisWorkbook.Sheets("Sheet1").Range("A1").CurrentRegion.Value
    arMyArray = Application.WorksheetFunction.Transpose(arMyArray)
   
   '----CHANGE THIS FOLDER PATH AND FILE NAME-----
   input_txt = ThisWorkbook.Sheets("Sheet1").Range("J2").Value
   
    dataFile = input_txt
       
    With Worksheets("PFI_CORE_USD_BOOK")
        .Cells.Clear
        .Range("A1:G1").Value = arMyArray
        Set dayReportDest = .Range("A2")
        dRow = 0
    End With
   ' Exit Sub

    Open dataFile For Input As #1
   
    n = 0
   
    While Not EOF(1)
   
        Line Input #1, fileLine
        Debug.Print fileLine

       
        parts = Split(Application.WorksheetFunction.Trim(fileLine), " ")
   
    'Table column parts are 7 then
   
        If UBound(parts) = 6 Then
            If IsNumeric(parts(0)) Or Not IsNumeric(parts(0)) Then
                n = n + 1
                ReDim Preserve dayData(1 To 15, 1 To n)
               
                dayData(1, n) = parts(0)
                dayData(2, n) = parts(1)
                dayData(3, n) = parts(2) & " " & parts(3)
                'dayData(4, n) = parts(3)
                dayData(4, n) = parts(4)
               
                    'If parts(4) = "CN" Or parts(4) = "CR" Or parts(4) = "JE" Then
                    If parts(4) = Sheet1.Range("I2").Value Or parts(4) = Sheet1.Range("I2").Value Or parts(4) = Sheet1.Range("I3").Value Then
                        dayData(6, n) = parts(5)
                        Else
                        dayData(5, n) = parts(5)
                    End If
                   
                'dayData(5, n) = parts(5)
                dayData(7, n) = parts(6)
              
            End If
           
'Table column parts are 6 then

        ElseIf UBound(parts) = 5 Then
            If IsNumeric(parts(0)) Or Not IsNumeric(parts(0)) Then
                n = n + 1
                ReDim Preserve dayData(1 To 15, 1 To n)
              
                dayData(1, n) = parts(0)
                dayData(2, n) = parts(1)
                dayData(3, n) = parts(2)
                dayData(4, n) = parts(3)
               
                'If parts(3) = "CN" Or parts(3) = "CR" Or parts(3) = "JE" Then
                If parts(3) = Sheet1.Range("I2").Value Or parts(3) = Sheet1.Range("I3").Value Or parts(3) = Sheet1.Range("I4").Value Then
                dayData(6, n) = parts(4)
               
                End If
                'dayData(5, n) = parts(4)
                dayData(7, n) = parts(5)

            End If
             
         'Table column parts are 8 then
        
         ElseIf UBound(parts) = 7 Then
            If IsNumeric(parts(0)) Or Not IsNumeric(parts(0)) Then
                n = n + 1
                ReDim Preserve dayData(1 To 15, 1 To n)
              
                dayData(1, n) = parts(0)
                dayData(2, n) = parts(1)
                dayData(3, n) = parts(2) & " " & parts(3) & " " & parts(4)
                'dayData(4, n) = parts(3)
                'dayData(5, n) = parts(4)
                dayData(4, n) = parts(5)
                'If parts(5) = "CN" Or parts(5) = "CR" Or parts(5) = "JE" Then
                If parts(5) = Sheet1.Range("I2").Value Or parts(5) = Sheet1.Range("I3").Value Or parts(5) = Sheet1.Range("I4").Value Then
                dayData(6, n) = parts(6)
                Else
                dayData(5, n) = parts(7)
                End If
                'dayData(5, n) = parts(6)
                dayData(7, n) = parts(7)
              

            End If
           
            'Table column parts are 9 then
           
        ElseIf UBound(parts) = 8 Then
            If IsNumeric(parts(0)) Or Not IsNumeric(parts(0)) Then
                n = n + 1
                ReDim Preserve dayData(1 To 15, 1 To n)
              
                dayData(1, n) = parts(0) '& " " & parts(1) & " " & parts(2)
                dayData(2, n) = parts(1)
                dayData(3, n) = parts(2)
                dayData(4, n) = parts(3)
                dayData(5, n) = parts(4)
                dayData(6, n) = parts(5)
                dayData(7, n) = parts(6)
                dayData(8, n) = parts(7)
                dayData(9, n) = parts(8)
              


            End If
       
        '-------------------------------------
           
           
          End If
       
        item = GetItem(fileLine, endpoint)  '------------End point------
        Debug.Print item
       
        If item <> "" Then
            For i = 1 To n
                dayData(15, i) = item
            Next
            dayReportDest.Offset(dRow, 0).Resize(n, UBound(dayData)).Value = Application.Transpose(dayData)
            dRow = dRow + n
            n = 0
        End If
               
    Wend
   
    Close #1

   
    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

-array-------

Option Explicit

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 endpoint As String
     Dim input_txt As String
    Dim dayReportDest As Range, dRow As Long
    Dim arMyArray() As Variant
    'Dim i As Integer
   
   
    endpoint = Sheet1.Range("G2").Value '"[URL='http://www.alfagomma.com']www.alfagomma.com[/URL]"
    arMyArray = ThisWorkbook.Sheets("Sheet1").Range("A1").CurrentRegion.Value
    arMyArray = Application.WorksheetFunction.Transpose(arMyArray)
   
   '----CHANGE THIS FOLDER PATH AND FILE NAME-----
   input_txt = ThisWorkbook.Sheets("Sheet1").Range("J2").Value
   
    dataFile = input_txt
       
    With Worksheets("PFI_CORE_USD_BOOK")
        .Cells.Clear
        .Range("A1:G1").Value = arMyArray
        Set dayReportDest = .Range("A2")
        dRow = 0
    End With
   ' Exit Sub

    Open dataFile For Input As #1
   
    n = 0
   
    While Not EOF(1)
   
        Line Input #1, fileLine
        Debug.Print fileLine

       
        parts = Split(Application.WorksheetFunction.Trim(fileLine), " ")
   
    'Table column parts are 7 then
   
        If UBound(parts) = 6 Then
            If IsNumeric(parts(0)) Or Not IsNumeric(parts(0)) Then
                n = n + 1
                ReDim Preserve dayData(1 To 15, 1 To n)
             For i = LBound(parts) To UBound(parts)
                dayData(i, n) = parts(i)
                'Debug.Print dayData(i, n)
                'Debug.Print parts(i)
                'MsgBox parts(i)
            If parts(i) = "CN" Or parts(i) = "CR" Or parts(i) = "JE" Then
                     'If parts(i) = "CN" Or parts(4) = "CR" Or parts(4) = "JE" Then
                           'If parts(4) = Sheet1.Range("I2").Value Or parts(4) = Sheet1.Range("I2").Value Or parts(4) = Sheet1.Range("I3").Value Then
                               dayData(i + 2, n) = parts(i + 1)
             ElseIf parts(i) = "IN" Then
                               dayData(i + 1, n) = parts(i + 1)
                               'Debug.Print parts(5)
                               Else
                               dayData(i, n) = parts(i)
            End If
                   
             Next i

           
           
          End If
       
        item = GetItem(fileLine, endpoint)  '------------End point------
        Debug.Print item
       
        If item <> "" Then
            For i = 1 To n
                dayData(15, i) = item
            Next
            dayReportDest.Offset(dRow, 0).Resize(n, UBound(dayData)).Value = Application.Transpose(dayData)
            dRow = dRow + n
            n = 0
        End If
               
    Wend
   
    Close #1

   
    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
 
Last edited by a moderator:
Sort by date Sort by votes
You cannot delete posts.
For the final time, do you actually have a question?
 
Upvote 0

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.
You haven't asked a question, just posted some code, which is why you have not had a reply.
 
Upvote 0
Not sure what you are after as you did NOT post a question. You only posted code and expected everyone to guess what you wanted. So here is my guess. I am assuming you want to import data from a NOTEPAD text file into excel.

If so have a look at this Yourtube video Link

Other wise POST a question. Advsing members on the forum of what its is that you want. Posting JUST code is of NO help
 
Upvote 0
Link helped but i have data in text file which have missing value in column.
 
Upvote 0
Best thing is to ASK A QUESTION and post a sample workbook, advising form members of what you have and what you want it to do. Rather than just post a code as you did in your first post.
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Question
How To Allow Only One Checkbox to Be Checked in Excel per Table
Replies
1
Views
88
bobsan42
bobsan42
S
  • Question
VBA to ignore certain MAC Address values but process all others
Replies
1
Views
192
myall_blues
myall_blues
I
  • Solved
Cell above is selected when i duplicate row
Replies
2
Views
85
ipbr21054
I
S
  • Solved
Working with multiple Target Ranges in Worksheet Code
Replies
3
Views
375
sspatriots
S
J
  • Solved
VBA to merge duplicate rows and sum values in certain column with adjustments
Replies
9
Views
330
Alex Blakenburg
A

Forum statistics

Threads
1,214,968
Messages
6,122,506
Members
449,089
Latest member
RandomExceller01

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top