Sub ExtractData()
'--what columns do you want?
' assuming that your table starts in row1 col1
' AND column headings are in row1
' AND every column in the table has a heading value
Dim iColHeading1 As Integer, iColHeading2 As Integer, iColHeading3 As Integer
Dim rngHeadings As Range, rngHeading As Range
Dim lRow As Long, iCol As Integer, lRowCount As Long, iColCount As Integer
Dim vArray(), idx As Integer, i, j
Set rngHeadings = Range(Cells(1, 1), Cells(1, 1).End(xlToRight))
For Each rngHeading In rngHeadings
With rngHeading
Select Case .Value
Case "Date" 'heading value from colA
iColHeading1 = .Column
Case "Whatever" 'heading value from colB
iColHeading2 = .Column
Case "Last" 'heading value from colD
iColHeading3 = .Column
End With
End With
Next
'>>OK now we know what columns we are in
' (incidently, we have just made it possible for you to insert a column ANYWHERE
' and as long as the heading values don't change, the procedure will get the right data!!!
'--Now we want to process each row ind select the data you want
With Cells(1, 1).CurrentRegion
lRowCount = .Rows.Count
iColCount = .Columns.Count
End With
idx = 1
For lRow = 2 To lRowCount
'--here's where you decide if this row is one that you want
If Cells(lRow, iColHeading1).Value = criterion Then
'redim the array
ReDim Preserve vArray(3, idx)
'assign the data
For iCol = 1 To iColCount
Select Case iCol
Case iColHeading1
vArray(0, idx - 1) = Cells(lRow, iColHeading1).Value
Case icilheading2
vArray(1, idx - 1) = Cells(lRow, iColHeading2).Value
Case iColHeading3
vArray(2, idx - 1) = Cells(lRow, iColHeading3).Value
'don't need any mor columns -- get out!
Exit For
End Select
Next
'incriment the index
idx = idx + 1
End If
Next
'--Now you have all the data that you've selected in an array
' and you can manipulate the array as follows
For i = LBound(vArray, 2) To UBound(vArray, 2)
For j = LBound(vArray, 1) To UBound(vArray, 1)
x = vArray(j, i)
Next
Next
End Sub
Skip,
.Select
