VBA script to extract/reduce data to certain parameters(columns)

[aadil177]

Hi Everyone,

I have a data file that has 600 columns and 14,000 rows of data. I am working on creating an excel GUI that lets you reduce this data to only the parameters you need. The parameters (headers) are in row 1.

Below is a screenshot of some of the input data

12680

To save time selecting the parameters from a filter list, I have created a .txt file that has a list of the parameters I need:

12681

I would like to read the list from the text file and reduce the data based upon this list. I would appreciate any ideas on how to do this.

To summarise the process, the idea is to have a gui that will let you browse and select the input data file (.xlsx) and then browse and select the .txt filter file, press go and output the reduced excel data file.

I have worked with matlab but am not very familiar with vba so any help would be much appreciated!

Thanks

Here is some sample data:
speedy.sh/4auhm/Sample-Data.xlsx

[snb]

The best idea is to upload a sample Excel file.

[aadil177]

I've added a link to the data, thanks

[Bob Phillips]

Why not insert a criteria row and have the filter respond to those values. Roger Govier shows how with his FastFilter workbook http://www.contextures.com/excelfilesRoger.html

[apo]

Hi..

Lets say you've read the txt file into an array (fArr in this case).. try the following..

I've used some static values for the fArr in this example..



Private Sub CommandButton1_Click()
Dim fArr, iArr, NewArr, x, i As Long, ii As Long
fArr = Array("FPC", "Module", "Date-End", "Ocupancy", "Time-Signed-Out", "BAROM_PRESS")
With Range("A1").CurrentRegion
x = Application.Transpose(.Value)
ReDim iArr(0 To UBound(fArr))
ReDim NewArr(0 To UBound(fArr), 1 To UBound(x, 2))
For i = LBound(fArr) To UBound(fArr)
iArr(i) = Application.Index(x, .Find(fArr(i), , , xlPart).Column, 0)
For ii = LBound(iArr(i)) To UBound(iArr(i))
NewArr(i, ii) = iArr(i)(ii)
Next ii
Next i
End With
With Sheets("Sheet1")
.Range("A1").Resize(UBound(x, 2), UBound(NewArr) + 1).Value = Application.Transpose(NewArr)
.Select
End With
End Sub


Question to anyone who might know..

Is there a way to transpose the iArr array directly to the sheet at the end.. instead of having to build a new array (NewArr) and then transposing that?

[snb]

To delete the columns you don't need (based on the column names in the txt-file):


Sub M_snb()
c00=createobject("scripting.filesystemobject").opentextfile("G:\OF\selection.txt").readall

for each cl in sheet1.rows(1).specialcells(2)
if instr(c00,cl.value)=0 then cl.value=""
next

sheet1.rows(1).specialcells(4).entirecolumn.delete
End Sub

[apo]

As usual.. snb determines the most logical course of action.. :)

@ snb..

My further research has yielded nothing in regards to this:

Is there a way to transpose the iArr array directly to the sheet at the end.. instead of having to build a new array (NewArr) and then transposing that?

As an example.. surely if i could transpose the iArr array to the sheet.. I wouldn't need the second loop (ii loop)..

Is this even possible..?

iArr(0)(1)
iArr(0)(2)
..
..
iArr(1)(1)
iArr(1)(2)
..
..
iArr(2)(1)
iArr(2)(2)
..
..

[snb]

@apo

assume:
- the column names in string 'c00'
- all the data that have to be filtered in array 'sn'
- the filtered array in array 'sp'

You can filter an array by 'column' using application.index:


Sub M_snb()
c00 ="FPC,Module,Date-End,Occupancy,Time-Signed-Out,BAROM_PRESS"
sn = Cells(1).CurrentRegion

For j = 1 To UBound(sn, 2)
If InStr(c00, sn(1, j)) Then c01 = c01 & " " & j
Next

sp = Application.Index(sn, Evaluate("row(1:" & UBound(sn) & ")"), Split(Trim(c01)))

Cells(30, 1).Resize(UBound(sp), UBound(sp, 2)) = sp
End Sub

[apo]

Beautiful.. thank you.

Like most things that I can't find.. it was right in front of me on your website also in your Array section..

http://www.snb-vba.eu/VBA_Arrays_en.html#L_6

I think I need to brush up on my 'research' skills.. :)

[snb]

I won't blame you in your hot environment. Keeping your head cool must be a difficult task....
Hope the fire isn't in your neighbourhood.