在VBA中查找列并进行排序

Question

Hi there I'm trying to create a macro to make it easier to sort data exported from a robot

The trouble is the columns can change places due to the way in which the robot does the testing

Many of the columns are useless and so I have made a macro to hide the unused columns and now I would like to add a macro that sorts these remaining 4 columns in Ascending order but I just can't crack it

So far I have

Dim c As Range

For Each c In Range("A1:BR1").Cells
    If c.Value = "Plate Name (barcode)" Or c.Value = "Measurement Date" Or c.Value = "Measurement profile" Or c.Value = "pH" Or c.Value = "Count" Or c.Value <= 30 Then
    c.EntireColumn.Hidden = False
    Else: c.EntireColumn.Hidden = True
    End If
    Next c
End Sub

Which hides every column other then the named ones but I can't get it to sort the data after this

I've tried to findcolumn/selectcolumn and sort but for some reason the macro seems to run and not actually sort

Also tried recording macro but as the columns move the code keeps defining the columns to sort as eg "D:D" or "AB:AB" however it might not always be in these columns so I need to SEARCH FOR THE HEADER then sort

Any help would be appreciated!

Answer 1

See if something like this works for you...

The code assumes that there is no blank column in between the data set.

Sub SortColumns()
Dim i As Long, j As Long, lc As Long
Dim vKeys()
lc = ActiveSheet.UsedRange.Columns.Count
For i = lc To 1 Step -1
    If Columns(i).Hidden = False Then
        j = j + 1
        ReDim Preserve vKeys(1 To j)
        vKeys(j) = Cells(2, i).Address
    End If
Next i
'vKeys(4) --> First visible column from left
'vKeys(3) --> Second visible column from left
'vKeys(2) --> Third visible column from left
'vKeys(1) --> Fourth visible column from left
Range("A1").CurrentRegion.Sort key1:=Range(vKeys(4)), order1:=xlAscending, key2:=Range(vKeys(3)), order2:=xlAscending, key3:=Range(vKeys(2)), order3:=xlAscending, Header:=xlYes
Range("A1").CurrentRegion.Sort key1:=Range(vKeys(1)), order1:=xlAscending, Header:=xlYes
End Sub