Copy selected rows from txt file and paste to excel based on one criteria applied on one column

[katherine_nicccc]

Hi, i am relatively new to VBA and i have problem importing data from text file. As the text file is too big, i do not want copy all data over to excel.

Is there a way for me to create a VBA that only copies out all the rows with the same product ID as value in Cell A1? Then copy these rows (entire row) to a blank worksheet (say named "extracted_data")

My text file looks like this but with a lot more column and rows.

Start Date	End Date	Product ID	Field 4	Field 5 and many other fields
xx	xx	12	xx	xx
xx	xx	12	xx	xx
xx	xx	12	xx	xx
xx	xx	44	xx	xx
xx	xx	44	xx	xx

Thank you for you help!

 

[rabsofty]

i have a spreadsheet with existing code that i remodified for you

Sub getdata()
  Set awf = Application.WorksheetFunction

'next line, place path and your filename
  lv = openfile("C:/temp/", "", "sometext.txt", 1, 2)
  lnarr = lv(0)
  Dim t1() As Variant
  j1 = -1
  If UBound(lnarr) > -1 Then
    For x = 0 To UBound(lnarr) - 1
'next line assumes space as the delimeter
      sw = Split(lnarr(x), " ", , 1)
      nflds = UBound(sw)
'next line assumes product id is column 3 (which in the sw() array is 2 - array starts at zero)
'same line, also assumes product id is in Sheets("extracted_data").Cells(1, 1) 
     If sw(2) = awf.Text(Sheets("extracted_data").Cells(1, 1), 0) Then j1 = j1 + 1: ReDim Preserve t1(j1): t1(j1) = sw
    Next x
    If j1 <> -1 Then  Range(Sheets("extracted_data").Cells(3, 1), Sheets("extracted_data").Cells(3 + j1, nflds+1)).Value = awf.Transpose(awf.Transpose(t1))
  End If
End Sub

Function openfile(m1, s1, f1, fid, mode)
'open a file
  pauseonce = False: fls = 2: lns = Empty: awp = m1 & s1: fpath = awp & f1
  On Error Resume Next
  x = Dir(awp, 16): If x = "" Then MkDir awp
  Do
    Err.Clear
    Select Case mode
      Case 0: Open fpath For Append Lock Read Write As #fid
      Case 1: Open fpath For Output Lock Read Write As #fid
      Case 2: Open fpath For Input Lock Read As #fid
    End Select
    If Err = 0 Then
      fls = 0: If mode = 2 Then lns = lar(fid)
      Exit Do
    Else
      If mode = 2 And Err = 53 Then fls = 1: Exit Do
      Close: Exit Do
    End If
  Loop
  On Error GoTo 0
  Dim ev(1)
  ev(0) = lns: ev(1) = fls: openfile = ev
End Function
Function lar(e1)
'e1=fid
  fcont = Input(LOF(e1), e1): Close
  lar = Split(fcont, vbCrLf): Set fcont = Nothing
End Function

To run the code,
place the product code in Sheets("extracted_data").Cells(1, 1)
run the macro getdata()

 

[rabsofty]

any questions you need answered about the code, feel free to post it and i will answer them

 

[dmt32]

Hi

Welcome to the forum

You should be able to do what you want by filtering the range & copying result to the worksheet.

Try following & see if does what you want

1 – Insert a new worksheet & name it extracted_data

2 – Your master data sheet layout should be as example below with row 4 being the header row & cell A2 as value entry cell.

01-04-2024.xls
	A	B	C	D	E
1	Product ID
2	12
3
4	Start Date	End Date	Product ID	Field 4	Field 5 and many other fields
5	xx	xx	12	xx	xx
6	xx	xx	12	xx	xx
7	xx	xx	12	xx	xx
8	xx	xx	44	xx	xx
9	xx	xx	44	xx	xx
10
Sheet1

3 - Copy code below & place in the master data worksheet code page (Right Click Tab > View Code)

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rngDest     As Range, rngCopy As Range
    
    If Target.CountLarge > 1 Then Exit Sub
    
    If Target.Address = "$A$2" Then
    
        Set rngCopy = Me.Range("A4").CurrentRegion
        
        Set rngDest = Worksheets("extracted_data").Range("A1")
        
        'copy filtered data to sheet
        rngCopy.AdvancedFilter Action:=xlFilterCopy, _
                                                 CriteriaRange:=Me.Range("A1:A2"), _
                                                 CopyToRange:=rngDest.Resize(, rngCopy.Columns.Count)
        With rngDest: .Parent.Activate: .Select: End With
    End If
    
End Sub

When done, Exit the VBA editor and enter a value in cell A2.

Any Product ID matching that value should copy to your extracted_data worksheet but just be aware that for first use, you probably will need to adjust the column widths to match your master sheet.

Hope Helpful

Dave

 

[rabsofty]

Hi Dave @dmt32

I tried the code you provided and it does work.
But i found if other data is in the extracted_data sheet, i get the error
(Run time 1004: The extract has an invalid or missing field name)

on this line

rngCopy.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Me.Range("A1:A2"), CopyToRange:=rngDest.Resize(, rngCopy.Columns.Count)

I can correct it by clearing out the data on the extracted_data sheet

 

[dmt32]

i found if other data is in the extracted_data sheet, i get the error

I can correct it by clearing out the data on the extracted_data sheet

Hi,
thanks for feedback - code works ok for me - the error suggests that one or more of the fields in the header row is missing when you perform the extract.
It may just be a quirk between versions in way code is written & need a minor update to allow for this but, I'll wait & see how OP gets on if they decide to use suggestion.

Dave