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

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.
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

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