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

S

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

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).
Sort by date Sort by votes
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
Bosquedeguate said:
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?
Click to expand...
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
Bosquedeguate said:
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
Click to expand...
Thanks! This helped
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Solved
VBA Code To Loop Through One Worksheet and Paste Certain Values Into Another
Replies
5
Views
137
Peter_SSs
Peter_SSs
Cliffork
  • Solved
Print to PDF Macro, or possibly more
2 3
Replies
21
Views
314
mumps
mumps
R
  • Solved
Count words in a line of a txt file
Replies
4
Views
265
Ridelmou
R
A
  • Question Question
Using ADODB way t populate data under header from file to another
Replies
0
Views
63
abdo meghari
A
L
  • Question Question
Send cell values to 2 other sheets according to condition
Replies
2
Views
199
leobrice
L

Forum statistics

Threads
1,223,867
Messages
6,175,062
Members
452,610
Latest member
Sherijoe

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