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:

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.
Sort by date Sort by votes
VBA Code: 
for missing values --



Option Explicit

Public Sub Import_Text_File()
On Error Resume Next

Dim dataFile As String 'Notepad file
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 dayReportDest As Range 'pasting the data to excel
Dim dRow As Long ' for offset the row
Dim arMyArray() As Variant
Dim input_txt As String
Dim uboundCount As Integer
Dim j As Integer
Dim k As Integer
Dim delarray As Integer
Dim userspace As Integer

'endpoint = "total:" 'Sheet1.Range("G2").Value
arMyArray = ThisWorkbook.Sheets("Config").Range("A1").CurrentRegion.Value
arMyArray = Application.WorksheetFunction.Transpose(arMyArray)


input_txt = "C:\Users\rohit\Desktop\Notepaddataextraction\Data.txt"
'----CHANGE THIS FOLDER PATH AND FILE NAME-----
dataFile = input_txt

With Worksheets("Home")
.Cells.Clear
.Range("A1:F1").Value = arMyArray
Set dayReportDest = .Range("A2")
dRow = 0
'.Range("E1").EntireColumn.NumberFormat = "@"

End With
' Exit Sub

Open dataFile For Input As #1

n = 0
For delarray = 1 To 7
    arMyArray(delarray - 1) = ""
Next delarray
While Not EOF(1)

Line Input #1, fileLine
Debug.Print fileLine



parts = Split(Application.WorksheetFunction.Trim(fileLine), " ")
'MsgBox Len(Trim(fileLine))
 If UBound(parts) <= 5 Then
If UBound(arMyArray) - 1 <> UBound(parts) Then
'MsgBox "Yes"
    If IsNumeric(parts(0)) Or Not IsNumeric(parts(0)) Then
        n = n + 1
        userspace = 1
        ReDim dayData(1 To UBound(arMyArray), 1 To n)
            For i = 1 To UBound(arMyArray)
            dayData(i, n) = parts(i - 1)
                If userspace = 5 Then  'Column no having missing value
                dayData(i, n) = ""
                ElseIf userspace > 5 Then
                dayData(i, n) = parts(i - 2)
                Else
                dayData(i, n) = parts(i - 1)
                End If
                userspace = userspace + 1
            Next i
            
            
  
    End If
    Else
'End If
'    If UBound(parts) <= 5 Then
        If IsNumeric(parts(0)) Or Not IsNumeric(parts(0)) Then
            n = n + 1
            ReDim dayData(1 To UBound(parts) + 1, 1 To n)
                        For i = 1 To UBound(parts) + 1
                            dayData(i, n) = parts(i - 1)
                        Next i
            'End If
            'End If
            'Else

'            If IsNumeric(parts(0)) Or Not IsNumeric(parts(0)) Then
'            n = n + 1
'            ReDim dayData(1 To UBound(parts) + 1, 1 To n)
'            k = 1
'            For j = 1 To UBound(parts)
'
'            dayData(j, n) = parts(j - 1)
'            If k = 1 Then ' space in column 2
'                        dayData(j, n) = parts(k - 1) & parts(k)
'                    ElseIf k > 1 Then
'
'
'                        dayData(j, n) = parts(j)
'                    End If
'
'                    k = k + 1
'                    'dayData(j, n) = ""
'            Next j
'
'
End If
End If
End If

            
          
item = GetItem(fileLine, endpoint) '------------End point------

            If item <> "" Then
'                        For i = 1 To n
'                        dayData(UBound(parts) + 1, 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


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
'-----------------------

space1-
''-----------
Option Explicit

Public Sub Import_Text_File_space1()
On Error Resume Next

Dim dataFile As String 'Notepad file
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 dayReportDest As Range 'pasting the data to excel
Dim dRow As Long ' for offset the row
Dim arMyArray() As Variant
Dim input_txt As String
Dim uboundCount As Integer
Dim j As Integer
Dim k As Integer

'endpoint = "total:" 'Sheet1.Range("G2").Value
arMyArray = ThisWorkbook.Sheets("Config").Range("A1").CurrentRegion.Value
arMyArray = Application.WorksheetFunction.Transpose(arMyArray)


input_txt = "C:\Users\rohit\Desktop\Notepaddataextraction\Data.txt"
'----CHANGE THIS FOLDER PATH AND FILE NAME-----
dataFile = input_txt

With Worksheets("Home")
.Cells.Clear
.Range("A1:E1").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



parts = Split(Application.WorksheetFunction.Trim(fileLine), " ")

'For uboundCount = 4 To 12
    If UBound(parts) <= 5 Then
        If IsNumeric(parts(0)) Or Not IsNumeric(parts(0)) Then
            n = n + 1
            ReDim dayData(1 To UBound(parts) + 1, 1 To n)
            
            
            
            For i = 1 To UBound(parts) + 1
                
                            dayData(i, n) = parts(i - 1)
              
            Next i
            'End If
            End If
            Else
        
            If IsNumeric(parts(0)) Or Not IsNumeric(parts(0)) Then
            n = n + 1
            ReDim dayData(1 To UBound(parts) + 1, 1 To n)
            k = 1
            For j = 1 To UBound(parts)
            
            dayData(j, n) = parts(j - 1)
            If k = 1 Then ' space in column 2
                        dayData(j, n) = parts(k - 1) & parts(k)
                    ElseIf k > 1 Then
                        
                    
                        dayData(j, n) = parts(j)
                    End If
                    
                    k = k + 1
                    'dayData(j, n) = ""
            Next j
            
            
End If
End If
            
            
            'solved for space in column 2
'            ReDim dayData(1 To UBound(parts) + 1, 1 To n)
'            For i = 1 To UBound(parts) + 1
'                If uboundCount = 6 Then
'                    If i = 2 Then ' space in column 2
'                        dayData(i, n) = parts(i - 1) & parts(i)
'                    ElseIf i = 1 Then
'                        dayData(i, n) = parts(i - 1)
'                        Else
'                        dayData(i, n) = parts(i)
'                    End If
'                Else
'                    dayData(i, n) = parts(i - 1)
'                End If
'            Next i
'        End If
'    End If
'Next uboundCount
item = GetItem(fileLine, endpoint) '------------End point------
'Debug.Print item

            If item <> "" Then
'                        For i = 1 To n
'                        dayData(UBound(parts) + 1, 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


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
'-----------------------
 
Upvote 0
not for issue --

VBA Code: 
Option Explicit
Public dataFile As String 'Notepad file
Public fileLine As String, item As String, parts As Variant
Public i As Long, n As Long
Public dayData() As Variant
Public endpoint As String
Public dayReportDest As Range 'pasting the data to excel
Public dRow As Long ' for offset the row
Public arMyArray() As Variant
Public input_txt As String
Public uboundCount As Integer
Public j As Integer
Public k As Integer
Public delarray As Integer
Public userspace As Integer

Public Sub Import_Text_File()
On Error Resume Next



'endpoint = "total:" 'Sheet1.Range("G2").Value
arMyArray = ThisWorkbook.Sheets("Config").Range("A1").CurrentRegion.Value
arMyArray = Application.WorksheetFunction.Transpose(arMyArray)


input_txt = "C:\Users\rohit\Desktop\Notepaddataextraction\Data.txt"
'----CHANGE THIS FOLDER PATH AND FILE NAME-----
dataFile = input_txt

With Worksheets("Home")
.Cells.Clear
.Range("A1:F1").Value = arMyArray
Set dayReportDest = .Range("A2")
dRow = 0
'.Range("E1").EntireColumn.NumberFormat = "@"

End With
' Exit Sub

Open dataFile For Input As #1

n = 0
For delarray = 1 To 7
    arMyArray(delarray - 1) = ""
Next delarray
While Not EOF(1)

Line Input #1, fileLine
Debug.Print fileLine



parts = Split(Application.WorksheetFunction.Trim(fileLine), " ")
'MsgBox Len(Trim(fileLine))
If UBound(parts) < 5 Then

    '--------Missing value part-------------
    If UBound(arMyArray) - 1 <> UBound(parts) Then
    'MsgBox "Yes"
            If IsNumeric(parts(0)) Or Not IsNumeric(parts(0)) Then
                   n = n + 1
                   userspace = 1
                   ReDim dayData(1 To UBound(arMyArray), 1 To n)
                       For i = 1 To UBound(arMyArray)
                       dayData(i, n) = parts(i - 1)
                           If userspace = 5 Then  'Column no having missing value
                               dayData(i, n) = ""
                               ElseIf userspace > 5 Then
                               dayData(i, n) = parts(i - 2)
                               Else
                               dayData(i, n) = parts(i - 1)
                           End If
                           userspace = userspace + 1
                       Next i
               End If
      End If
    '------------Concat data---------------------------
   
ElseIf UBound(parts) > 5 Then
       
        If IsNumeric(parts(0)) Or Not IsNumeric(parts(0)) Then
                n = n + 1
                ReDim dayData(1 To UBound(parts) + 1, 1 To n)
                k = 1
                For j = 1 To UBound(parts)
               
                dayData(j, n) = parts(j - 1)
                    If k = 1 Then ' space in column 2
                                dayData(j, n) = parts(k - 1) & parts(k)
                    ElseIf k > 1 Then
                        dayData(j, n) = parts(j)
                    End If
                    k = k + 1
                        'dayData(j, n) = ""
                Next j
        End If
       
ElseIf UBound(parts) = 5 Then
    '----------For normal data row
        'If UBound(parts) <= 5 Then
                If IsNumeric(parts(0)) Or Not IsNumeric(parts(0)) Then
                n = n + 1
                ReDim dayData(1 To UBound(parts) + 1, 1 To n)
                            For i = 1 To UBound(parts) + 1
                                dayData(i, n) = parts(i - 1)
                            Next i
                End If
End If
item = GetItem(fileLine, endpoint) '------------End point------

            If item <> "" Then
'                        For i = 1 To n
'                        dayData(UBound(parts) + 1, 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


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:
Upvote 0
Do you actually have a question?
If so please ask it. If not say so & will remove the thread.
 
Upvote 0
Do you actually have a question?
Continually bumping the thread, will not help as you haven't asked any question yet, despite being asked to.
 
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
99
bobsan42
bobsan42
S
  • Question
VBA to ignore certain MAC Address values but process all others
Replies
1
Views
193
myall_blues
myall_blues
I
  • Solved
Cell above is selected when i duplicate row
Replies
2
Views
87
ipbr21054
I
S
  • Solved
Working with multiple Target Ranges in Worksheet Code
Replies
3
Views
376
sspatriots
S
J
  • Solved
VBA to merge duplicate rows and sum values in certain column with adjustments
Replies
9
Views
332
Alex Blakenburg
A

Forum statistics

Threads
1,215,065
Messages
6,122,944
Members
449,095
Latest member
nmaske

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