Extract data from text file then add data to last row

Zaifee

New Member
Joined
Feb 5, 2020
Messages
10
Office Version
  1. 2007
Platform
  1. Windows
Hi all,

Need your help to to add data to last row. (*Sorry for my bad English).
Im want extract data from text file to excel using VBA.
I got so different text file (based on date).
For the 1st time i manage to extract the data to the correct cell and column then when try to extract another data from another text file its been overwrite.
I need a code that can offset the next data below the first data.

VBA Code:
Private Sub CommandButton1_Click()

Dim myFile As String, text As String, textline As String
Dim sDate As Integer
Dim sID As Integer
Dim sT1 As Integer
Dim sT2 As Integer
Dim WS, WS1, WS2 As Worksheet

Set WS = Sheets("Main")
Set WS1 = Sheets("CtrThk")
Set WS2 = Sheets("TTV")

myFile = Sheets("Main").Range("B5")

'myFile = Application.GetOpenFilename()
Open myFile For Input As #1
    Do Until EOF(1)
        Line Input #1, textline
        text = text & textline
        
    Loop
Close #1

sDate = InStr(text, "Plant Order")
sID = InStr(text, "Inspector")
sT1 = InStr(text, "~P1")
sT2 = InStr(text, "~P2")
sT3 = InStr(text, "~P3")

WS1.Range("B11").Value = Mid(text, sDate + 36, 8)
WS1.Range("C11").Value = Mid(text, sID + 30, 5)
WS1.Range("D11").Value = Mid(text, sT1 + 30, 7)
WS1.Range("E11").Value = Mid(text, sT2 + 30, 7)
WS1.Range("F11").Value = Mid(text, sT3 + 30, 7)

WS2.Range("B11").Value = Mid(text, sDate + 36, 8)
WS2.Range("C11").Value = Mid(text, sID + 30, 5)
WS2.Range("D11").Value = Mid(text, sT1 + 44, 5)
WS2.Range("E11").Value = Mid(text, sT2 + 44, 5)
WS2.Range("F11").Value = Mid(text, sT3 + 44, 5)

End Sub
 

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest

Trebor76

Well-known Member
Joined
Jul 23, 2007
Messages
4,804
Hi *Zaifee,

Welciome to MrExcel!!

See how this goes:

VBA Code:
Option Explicit
Private Sub CommandButton1_Click()

Dim myFile As String, text As String, textline As String
Dim sDate As Integer
Dim sID As Integer
Dim sT1 As Integer
Dim sT2 As Integer
Dim WS As Worksheet, WS1 As Worksheet, WS2 As Worksheet
Dim lngPasteRow As Long

Set WS = Sheets("Main")
Set WS1 = Sheets("CtrThk")
Set WS2 = Sheets("TTV")

myFile = Sheets("Main").Range("B5")

'myFile = Application.GetOpenFilename()
Open myFile For Input As #1
    Do Until EOF(1)
        Line Input #1, textline
        text = text & textline
        
    Loop
Close #1

sDate = InStr(text, "Plant Order")
sID = InStr(text, "Inspector")
sT1 = InStr(text, "~P1")
sT2 = InStr(text, "~P2")
sT3 = InStr(text, "~P3")

With WS1
    lngPasteRow = .Range("B:F").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
    .Range("B" & lngPasteRow).Value = Mid(text, sDate + 36, 8)
    .Range("C" & lngPasteRow).Value = Mid(text, sID + 30, 5)
    .Range("D" & lngPasteRow).Value = Mid(text, sT1 + 30, 7)
    .Range("E" & lngPasteRow).Value = Mid(text, sT2 + 30, 7)
    .Range("F" & lngPasteRow).Value = Mid(text, sT3 + 30, 7)
End With

With WS2
    lngPasteRow = .Range("B:F").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
    .Range("B" & lngPasteRow).Value = Mid(text, sDate + 36, 8)
    .Range("C" & lngPasteRow).Value = Mid(text, sID + 30, 5)
    .Range("D" & lngPasteRow).Value = Mid(text, sT1 + 44, 5)
    .Range("E" & lngPasteRow).Value = Mid(text, sT2 + 44, 5)
    .Range("F" & lngPasteRow).Value = Mid(text, sT3 + 44, 5)
End With

End Sub

Regards,

Robert
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
13,749
Office Version
  1. 2007
Platform
  1. Windows
Try this
VBA Code:
dim lr as long
lr = ws1.range("B" & rows.count).end(xlup).row + 1
WS1.Range("B" & lr).Value = Mid(text, sDate + 36, 8)
WS1.Range("C" & lr).Value = Mid(text, sID + 30, 5)
WS1.Range("D" & lr).Value = Mid(text, sT1 + 30, 7)
WS1.Range("E" & lr).Value = Mid(text, sT2 + 30, 7)
WS1.Range("F" & lr).Value = Mid(text, sT3 + 30, 7)
lr = ws2.range("B" & rows.count).end(xlup).row + 1
WS2.Range("B" & lr).Value = Mid(text, sDate + 36, 8)
WS2.Range("C" & lr).Value = Mid(text, sID + 30, 5)
WS2.Range("D" & lr).Value = Mid(text, sT1 + 44, 5)
WS2.Range("E" & lr).Value = Mid(text, sT2 + 44, 5)
WS2.Range("F" & lr).Value = Mid(text, sT3 + 44, 5)
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
13,749
Office Version
  1. 2007
Platform
  1. Windows

ADVERTISEMENT

I'm glad to help you. Thanks for the feedback.
 

Zaifee

New Member
Joined
Feb 5, 2020
Messages
10
Office Version
  1. 2007
Platform
  1. Windows
Hi.

One more question. I want a msgbox to show "File not found" when the text file is not found. Thanks
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
13,749
Office Version
  1. 2007
Platform
  1. Windows
Try this

VBA Code:
  myFile = Sheets("Main").Range("B5")
  If Dir(myFile) = "" Then
    MsgBox "File not found"
    Exit Sub
  End If
 

Forum statistics

Threads
1,143,673
Messages
5,720,223
Members
422,270
Latest member
CaptainMurray

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
Top