?
Solved

Filter Excel Query Table with VBA on upload.

Posted on 2012-09-04
24
Medium Priority
?
678 Views
Last Modified: 2012-09-04
I have the code below, gained from a previous EE question. This basically makes three rows of space in a spreadsheet and then uploads the contents of a CSV file into the spreadsheet. The problem I am having is that the CSV contains some irrelevant data that should be filtered if possible as part of the upload... The CSV file has three comma separated rows e.g.

MyFile.txt,6347237,12
MyFile.txt,6347237,12
MyFile.rar,6347237,12
MyFile.txt,6347237,12

What I need to do is based on the first column of data (a filename) take only those rows that have a .txt file extension.

Any ideas?

    Application.ScreenUpdating = False
    Columns("A:A").Insert Shift:=xlToRight
    Columns("A:A").Insert Shift:=xlToRight
    Columns("A:A").Insert Shift:=xlToRight
    Application.ScreenUpdating = True
  
    Dim ws As Worksheet, strFile As String
    Set ws = ActiveWorkbook.Sheets("Master Results")
    strFile = ThisWorkbook.Path & "\targets.csv"
    With ws.QueryTables.Add(Connection:="TEXT;" & strFile, Destination:=ws.Range("A1"))
        .TextFileParseType = xlDelimited
        .TextFileCommaDelimiter = True
        .Refresh
    End With

Open in new window

0
Comment
Question by:Blowfelt82
  • 12
  • 12
24 Comments
 
LVL 24

Expert Comment

by:Steve
ID: 38363076
this little bit of code should do it:

LastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row

For x = LastRow To 1 Step -1
    If Not ActiveSheet.Cells(x, 1) Like "*.txt*" Then Range("A" & x & ":C" & x).Delete Shift:=xlUp
Next x

Open in new window


you also do not need the shift columns to right as the QueryTable does this automaticaly
you could also use the following rather than 3 lines:
Columns("A:C").Insert Shift:=xlToRight

Open in new window

0
 

Author Comment

by:Blowfelt82
ID: 38363085
That looks to be doing the job, only there is a lot of data so this is running quite slowly. Any tips to speed this up? I am have turned off screen updating but this hasnt had a massive impact. There is about 60k records involved.
0
 
LVL 24

Expert Comment

by:Steve
ID: 38363094
Is there data to the sides? as it is faster to delete the entire rows after filtering.
0
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 

Author Comment

by:Blowfelt82
ID: 38363098
Yes there are about 20 columns worth of data to the side!
0
 

Author Comment

by:Blowfelt82
ID: 38363111
To clarify, the data being uploaded is only temporary and is being loaded up for comparisons and lookups with the existing data (i.e. identifying new records introduced and changes that may have crept in). I am only trying to delete the data related to the CSV file (i.e. first three columns) the other data should be left alone (not sorted, filtered etc).
0
 

Author Comment

by:Blowfelt82
ID: 38363132
I guess one solution might be to do this processing in a seperate worksheet and then copy the filtered/deleted rows into the spreadsheet I want. Again this would have to be automated and again I dont know how!
0
 
LVL 24

Expert Comment

by:Steve
ID: 38363148
Do you have Headers in the csv file.. if you do could you post their names.
0
 
LVL 24

Expert Comment

by:Steve
ID: 38363159
The following code will trim down your csv file into a smaller file before you upload it.
This will be far far faster. This works if you have headers and change the field1 to that header.

strFile = ThisWorkbook.Path & "\targets.csv"
strPath = ThisWorkbook.Path & "\"

Set cn = CreateObject("ADODB.Connection")

strcon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strPath & ";Extended Properties=""text;HDR=Yes;FMT=Delimited"";"
 
cn.Open strcon

strSQL = "SELECT Field1, Field2, Field3 INTO targetsNew.csv FROM targets.csv WHERE (((Field1) Like '%txt%'));"
'Creates new csv file
cn.Execute strSQL
cn.Close
Set cn = Nothing

Open in new window

0
 

Author Comment

by:Blowfelt82
ID: 38363289
This looks great! I have some questions though...

My CSV input has column headers with spaces in it, so I guess this will just mean I have to wrap the names e.g. 'field name'.

Also strFile is declared but as far as I can see isnt used - I take it this gets appended to path to make a full path?

The WHERE statement used is searching on %txt% - although unlikely I would like to ensure that files with txt within the name are not included - so I will add a .txt to this.
0
 

Author Comment

by:Blowfelt82
ID: 38363305
This is also hitting me with an automation error, I guess due to the connection string? I have checked the file path and this is correct?
0
 
LVL 24

Expert Comment

by:Steve
ID: 38363314
Could you post the top two lines of the txt file and the code you have used, I will look at getting it working for you. (these can be a tad funky as just a little change can make all the difference)
0
 

Author Comment

by:Blowfelt82
ID: 38363336
"Source Filename","Number","Reference"
"Elevate45.txt","1.9","3"

Any good?
0
 
LVL 24

Expert Comment

by:Steve
ID: 38363338
Do they appear in the double quotes in the file?
0
 

Author Comment

by:Blowfelt82
ID: 38363355
yes
0
 

Author Comment

by:Blowfelt82
ID: 38363367
Having said that if possible I dont want the quotes in the output data?
0
 
LVL 24

Expert Comment

by:Steve
ID: 38363499
The quotes do throw up an issue with the code for the ADODB

This will do the job in excel after the table is in the sheet:

    ActiveSheet.Range("A1").AutoFilter
    ActiveSheet.Range("$A:$C").AutoFilter Field:=1, Criteria1:="<>*.txt*", Operator:=xlAnd
    ActiveSheet.Range("$A2:$C" & ActiveSheet.Rows.Count).SpecialCells(xlVisible).ClearContents
    Range("A1").AutoFilter
    With ActiveSheet.Sort
        .SetRange Range("$A1:$C" & ActiveSheet.Rows.Count)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

Open in new window

0
 
LVL 24

Expert Comment

by:Steve
ID: 38363513
The ADODB method is good if the file is in a good format.
This filter / clear / sort will do the job just as well.
0
 

Author Comment

by:Blowfelt82
ID: 38363580
This is almost there! The code filters out all the .txt files correctly but leaves them in place i.e. there are gaps where the other file types used to be they are not shifted to the top. The script also generates a run time error 1004 which I think is the reason for this? I will investigate and see if I can get any more detail.
0
 
LVL 24

Expert Comment

by:Steve
ID: 38363781
I have tested this.. the Activesheet.Sort should move all the rows back to the top.
Are you using Excel 2003? or 2007+
    Range("A1").AutoFilter
    ActiveSheet.Range("$A:$C").AutoFilter Field:=1, Criteria1:="<>*.txt*", Operator:=xlAnd
    ActiveSheet.Range("$A2:$C" & ActiveSheet.Rows.Count).SpecialCells(xlVisible).ClearContents
    ActiveSheet.Range("A1").AutoFilter

    With ActiveSheet.Sort
        .SetRange .Range("$A:$C")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

Open in new window

0
 

Author Comment

by:Blowfelt82
ID: 38363938
I am using 2007, I think the runtime error is preventing it from finishing the task... error 1004 is pretty generic though.
0
 
LVL 24

Accepted Solution

by:
Steve earned 2000 total points
ID: 38363996
All I can think is that the autofilter may be causing issue:
If you try this code after line 6:
    ActiveSheet.AutoFilterMode = False

    ActiveSheet.Sort.SortFields.Clear
    ActiveSheet.Sort.SortFields.Add Key:=Range("A:A"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveSheet.Sort
        .SetRange Range("A:C")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

Open in new window

0
 
LVL 24

Expert Comment

by:Steve
ID: 38364017
If you could post the full "as is" code at the moment, I can take a look and see if there is anythink out of place.
0
 

Author Closing Comment

by:Blowfelt82
ID: 38364055
Ta Dah! Worked like a charm - thanks for all you help yet again.
0
 
LVL 24

Expert Comment

by:Steve
ID: 38365502
OK, I am not sure you will see this but I hate to be outdone on an answer I know can be bettered so here you go... this will add three columns and then download the data for only what you require from the csv file...

Dim cmd As String
Dim src As String
Dim dsp As String
Columns("A:C").Insert

    dsp = "txt_" & Format(Now(), "hhmmss")
    src = "ODBC;DefaultDir=" & ThisWorkbook.Path & ";Driver={Microsoft Text Driver (*.txt; *.csv)};DriverId=27;FIL=text;MaxBufferSize=2048;MaxScanRows=8;PageTimeout=5;SafeTransactions=0;Threads=3;UID=admin;UserCommitSync=Yes;"
    cmd = "SELECT `targets`.`Source Filename`, `targets`.Reference, `targets`.Number" & Chr(13) & "" & Chr(10) & "FROM `targets.csv` `targets`" & Chr(13) & "" & Chr(10) & "WHERE (`targets`.`Source Filename` Like '%.txt%')"

    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=src, Destination:=Range("$A$1")).QueryTable
        .CommandText = cmd
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = dsp
        .Refresh BackgroundQuery:=False
    End With

Open in new window

0

Featured Post

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Access developers frequently have requirements to interact with Excel (import from or output to) in their applications.  You might be able to accomplish this with the TransferSpreadsheet and OutputTo methods, but in this series of articles I will di…
If you need to forecast numbers -- typically for finance -- the Windows and Mac versions of Excel 2016 have a basket of tools to get the job done.
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…

850 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question