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

Get help while writing formula
Click the italics "fx" icon to the left of the formula bar to open the Functions Arguments dialog. Help is displayed for each argument.
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
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

P
  • Question Question
Allow Manually Backspacing in Multi-selection Dropdown Cell - Currently Throwing Off Values
Replies
1
Views
353
Joe4
Joe4
B
  • Question Question
VBA Code to Send Mail to skip blank cells
Replies
1
Views
269
Micron
M
I
  • Solved
Irregular Data Set
2
Replies
19
Views
320
IdabaMalouki
I
D
  • Question Question
why show the frame of userform as the photo1
Replies
0
Views
197
david2005wang
D
N
  • Question Question
Hiding/showing rows between two values
Replies
1
Views
405
Joe4
Joe4

Forum statistics

Threads
1,223,231
Messages
6,170,885
Members
452,364
Latest member
springate

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