VBA: extract certain data from .txt file to new sheet

st34lth

New Member
Joined
Jul 21, 2023
Messages
3
Office Version
  1. 365
Platform
  1. Windows
I have a .txt file that I need to extract data from. Below is an excerpt from the .txt file. I'm only showing one Loadcase ID (for WS1) below but there are multiple in the .txt file (i.e., WS1, WS2, WS3, etc.) I need a macro that can read through the txt file and extract to a new sheet the loadcase ID, and the tabulated data below Bearing loads. Essentially, I only want the data shown in red below. The data below Bearing loads should be separated into columns, so there should be four columns of data. Thanks in advance for any help, and let me know if I need to provide more details.

Sample data from txt file:
Loadcase ID: WS1 Name: STR III-Angle: 0
Multiplier = 1.000

Cap loads:
Type Dir Arm Mag1 x1/L Mag2 x2/L ft kips, klf,k-ft kips, klf,k-ft
------------------------------------------------------------------------------- Force X 0.00 -8.61 0.50 ---- ----

Column loads:
Col # Type Dir Mag1 y1/L Mag2 y2/L
---------------------------------------------------------------------- 1 UDL X -0.957 klf 0.03 ---- 0.90

Bearing loads:
Line # Bearing # Dir. Load, kips
-------------------------------------------------
1 1 X -31.23
1 1 Y -28.55
1 1 Z 0.00
1 2 X -31.23
1 2 Y 22.88
1 2 Z 0.00
1 3 X -31.23
1 3 Y 22.88
1 3 Z 0.00
1 4 X -31.23
1 4 Y 74.30
1 4 Z 0.00
2 1 X -31.23
2 1 Y -28.55
2 1 Z 0.00
2 2 X -31.23
2 2 Y 22.88
2 2 Z 0.00
2 3 X -31.23
2 3 Y 22.88
2 3 Z 0.00
2 4 X -31.23
2 4 Y 74.30
2 4 Z 0.00


Auto generation details

Sample excel sheet output:
WS1
Bearing loads
1 1 X -31.23
1 1 Y -28.55
1 1 Z 0.00
1 2 X -31.23
1 2 Y 22.88
1 2 Z 0.00
1 3 X -31.23
1 3 Y 22.88
1 3 Z 0.00
1 4 X -31.23
1 4 Y 74.30
1 4 Z 0.00
2 1 X -31.23
2 1 Y -28.55
2 1 Z 0.00
2 2 X -31.23
2 2 Y 22.88
2 2 Z 0.00
2 3 X -31.23
2 3 Y 22.88
2 3 Z 0.00
2 4 X -31.23
2 4 Y 74.30
2 4 Z 0.00
 

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.
Hi:
Do you want the macro code to create multiple sheets? Or do you want to prompt for a "Load Case ID" and create Sheets on a a case-by-case basis?

Also, if a sheet with the Load Case ID already exists do you append new data, overwrite the existing data, or generate an error message?
 
Upvote 0
Hi:
Do you want the macro code to create multiple sheets? Or do you want to prompt for a "Load Case ID" and create Sheets on a a case-by-case basis?

Also, if a sheet with the Load Case ID already exists do you append new data, overwrite the existing data, or generate an error message?
Hey!
I want to create only one sheet that will contain all WSx (where x is any integer) loadcases with one blank row separating every Loadcase ID.

For example:

WS1
Bearing loads
1 1 X -31.23
.
.
2 4 Z 0.00

WS2
Bearing loads
1 1 X 0.00
.
.
2 4 Z 0.00

WS3
Bearing loads
1 1 X 0.00
.
.
2 4 Z 0.00
 
Upvote 0
Here is version of the code that creates separate worksheets.

Note: there is No validity testing of the data. It expects consistent formatting of records "Loadcase ID", "Bearing Loads"

VBA Code:
Sub ImportLoadCaseData()
  Dim sheet As Worksheet
  Dim rng As Range
  Dim r
  
  fileToOpen = Application.GetOpenFilename("Text Files (*.txt), *.txt")
  If fileToOpen <> False Then
  
    Open fileToOpen For Input As #1
    
    
    'Loop through records until a "LOAD CASE ID:" record is found
    Do While Not EOF(1)
      Do While Not EOF(1) ' Loop until end of file.
        Line Input #1, textline ' Read line into variable.
  '      Debug.Print Textline ' Print to the Immediate window.
        
        tmp = Split(textline, " ")
        If UBound(tmp) > 0 Then
          
          If Left(UCase(textline), 12) = "LOADCASE ID:" Then
            Debug.Print tmp(2)
            If Not FindWorksheet(tmp(2)) Then
              Set sheet = Worksheets.Add()
              sheet.Name = tmp(2)
              Set rng = sheet.Range("A1")
              rng = tmp(2)
              r = 3
              Exit Do
            End If
          End If
        End If
      Loop
    
      'Loop through records until a "BEARING LOADS:" record is found
      Do While Not EOF(1)
        Line Input #1, textline
        If Left(UCase(textline), 14) = "BEARING LOADS:" Then
          Debug.Print textline
          Set rng = sheet.Range("A2")
          rng = textline
          Exit Do
        End If
      Loop
      
      Do While Not EOF(1)
        Line Input #1, textline
        tmp = Split(textline, " ")
        If Not Left(textline, 3) = "---" Then
          If UBound(tmp) >= 3 Then
            If IsNumeric(tmp(0)) Then
              Debug.Print tmp(0), tmp(1), tmp(2), tmp(3)
              Set rng = sheet.Range("A" & r & ":D" & r)
              rng = tmp
              r = r + 1
            End If
          Else
            Exit Do
          End If
        End If
      Loop
          
    Loop
    Close #1 ' Close file.
  End If
End Sub

Function FindWorksheet(worksheetname) As Boolean
  FindWorksheet = False
  i = 0
  For Each wks In Worksheets
    If wks.Name = worksheetname Then
      FindWorksheet = True
      Exit For
    End If
  Next
End Function
 
Upvote 0
so if/when there are multiple Loadcase ID's in the file the sheet will be named according to the first Loadcase ID it finds? Then all others will be listed in the first sheet (WS1 in this test case)?
 
Upvote 0
Modified code that puts all the WSn datasets in one worksheet.
VBA Code:
Sub ImportLoadCaseData()
  Dim sheet As Worksheet
  Dim rng As Range
  Dim r
  
  fileToOpen = Application.GetOpenFilename("Text Files (*.txt), *.txt")
  If fileToOpen <> False Then
  
    Open fileToOpen For Input As #1
    
    
    'Loop through records until a "LOAD CASE ID:" record is found
    Do While Not EOF(1)
      Do While Not EOF(1) ' Loop until end of file.
        Line Input #1, textline ' Read line into variable.
  '      Debug.Print Textline ' Print to the Immediate window.
        
        tmp = Split(textline, " ")
        If UBound(tmp) > 0 Then
          
          If Left(UCase(textline), 12) = "LOADCASE ID:" Then
            Debug.Print tmp(2)
            If Not FindWorksheet(tmp(2)) Then
              If sheet Is Nothing Then
                Set sheet = Worksheets.Add()
                sheet.Name = tmp(2)
                r = 1
              Else
                r = r + 1
              End If
              Set rng = sheet.Range("A" & r)
              rng = tmp(2)
              r = r + 1
              Exit Do
            End If
          End If
        End If
      Loop
    
      'Loop through records until a "BEARING LOADS:" record is found
      Do While Not EOF(1)
        Line Input #1, textline
        If Left(UCase(textline), 14) = "BEARING LOADS:" Then
          Debug.Print textline
          Set rng = sheet.Range("A" & r)
          rng = textline
          r = r + 1
          Exit Do
        End If
      Loop
      
      Do While Not EOF(1)
        Line Input #1, textline
        tmp = Split(textline, " ")
        If Not Left(textline, 3) = "---" Then
          If UBound(tmp) >= 3 Then
            If IsNumeric(tmp(0)) Then
              Debug.Print tmp(0), tmp(1), tmp(2), tmp(3)
              Set rng = sheet.Range("A" & r & ":D" & r)
              rng = tmp
              r = r + 1
            End If
          Else
            Exit Do
          End If
        End If
      Loop
          
    Loop
    Close #1 ' Close file.
  End If
End Sub

Function FindWorksheet(worksheetname) As Boolean
  FindWorksheet = False
  i = 0
  For Each wks In Worksheets
    If wks.Name = worksheetname Then
      FindWorksheet = True
      Exit For
    End If
  Next
End Function
 
Upvote 0
Modified code that puts all the WSn datasets in one worksheet.
VBA Code:
Sub ImportLoadCaseData()
  Dim sheet As Worksheet
  Dim rng As Range
  Dim r
 
  fileToOpen = Application.GetOpenFilename("Text Files (*.txt), *.txt")
  If fileToOpen <> False Then
 
    Open fileToOpen For Input As #1
   
   
    'Loop through records until a "LOAD CASE ID:" record is found
    Do While Not EOF(1)
      Do While Not EOF(1) ' Loop until end of file.
        Line Input #1, textline ' Read line into variable.
  '      Debug.Print Textline ' Print to the Immediate window.
       
        tmp = Split(textline, " ")
        If UBound(tmp) > 0 Then
         
          If Left(UCase(textline), 12) = "LOADCASE ID:" Then
            Debug.Print tmp(2)
            If Not FindWorksheet(tmp(2)) Then
              If sheet Is Nothing Then
                Set sheet = Worksheets.Add()
                sheet.Name = tmp(2)
                r = 1
              Else
                r = r + 1
              End If
              Set rng = sheet.Range("A" & r)
              rng = tmp(2)
              r = r + 1
              Exit Do
            End If
          End If
        End If
      Loop
   
      'Loop through records until a "BEARING LOADS:" record is found
      Do While Not EOF(1)
        Line Input #1, textline
        If Left(UCase(textline), 14) = "BEARING LOADS:" Then
          Debug.Print textline
          Set rng = sheet.Range("A" & r)
          rng = textline
          r = r + 1
          Exit Do
        End If
      Loop
     
      Do While Not EOF(1)
        Line Input #1, textline
        tmp = Split(textline, " ")
        If Not Left(textline, 3) = "---" Then
          If UBound(tmp) >= 3 Then
            If IsNumeric(tmp(0)) Then
              Debug.Print tmp(0), tmp(1), tmp(2), tmp(3)
              Set rng = sheet.Range("A" & r & ":D" & r)
              rng = tmp
              r = r + 1
            End If
          Else
            Exit Do
          End If
        End If
      Loop
         
    Loop
    Close #1 ' Close file.
  End If
End Sub

Function FindWorksheet(worksheetname) As Boolean
  FindWorksheet = False
  i = 0
  For Each wks In Worksheets
    If wks.Name = worksheetname Then
      FindWorksheet = True
      Exit For
    End If
  Next
End Function
Thanks! This helped
 
Upvote 0

Forum statistics

Threads
1,224,811
Messages
6,181,081
Members
453,021
Latest member
Justyna P

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