Question

I have a data set for an unrelated classification problem I am going true, and I want to cut down on the number of attribute totals. I’ve put my data set into a CSV format which excel handles quite nicely, but I need to make some changes – and I’ve never done any VBA so the syntax seems extremely foreign to me.

Basically, I have 7071 columns (attributes) and 70 rows (instances). Cells below each of the columns (say A75 for column A) contain a certain statistic method for attribute evaluation. What I want to do is check against the value in this cell (“A75” in this example), and if it is below a certain threshold, delete the entire column as well as shift everything to the left. So if I had something like :

o A B C D ... XYZ

1 2 5 4 9 ... 2

2 3 9 0 1 ... 3

3 1 1 5 6 ... 0

...

75 0.23 0.5 0.6 0.44 ... 0.8

And my calculations determined that the minimum threshold is 0.3, then the macro would get rid of column A and shift the others to the left:

o A B C ... XYZ

1 5 4 9 ... 2

2 9 0 1 ... 3

3 1 5 6 ... 0

...

75 0.5 0.6 0.44 ... 0.8

Any help at all would be greatly appreciated.

Answer 1

This should do it for you. If you deleting rows or columns begin deleting from the end and move to the start (ie right to left or bottom to top).

Option Explicit

Sub RemoveColumns()
    Dim vEvalRange As Variant, ii As Integer

    'NOTE: This assumes the usedrange starts at cell A1!

    'Screen updating when deleting cells slows things down
    Application.ScreenUpdating = False

    'Set your evaluation row to an array.  It's faster to sort through variables than sheet ranges
    vEvalRange = ActiveSheet.Range(ActiveSheet.Cells(ActiveSheet.UsedRange.Rows.Count, 1), ActiveSheet.Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count)).Value

    'count from right to left otherwise your columns will shift and mess up your array
    For ii = UBound(vEvalRange, 2) To LBound(vEvalRange, 2) Step -1
        If vEvalRange(1, ii) < 0.3 Then
            ActiveSheet.Columns(ii).Delete
        End If
    Next ii

    Application.ScreenUpdating = True
End Sub