Extract data from text file then add data to last row

[Zaifee]

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.

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

 

[Trebor76]

Hi *Zaifee,

Welciome to MrExcel!!

See how this goes:

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]

Try this

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)

 

[Zaifee]

Thanks guy. Works perfect!!..

 

[DanteAmor]

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

 

[Zaifee]

Hi.

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

 

[DanteAmor]

Try this

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