View Full Version : VBA script to extract/reduce data to certain parameters(columns)
aadil177
01-05-2015, 01:49 AM
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
The best idea is to upload a sample Excel file.
aadil177
01-05-2015, 04:34 AM
I've added a link to the data, thanks
Bob Phillips
01-05-2015, 06:21 AM
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
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?
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
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)
..
..
@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
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.. :)
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.
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.