2012-08-11

excel macro to re-order / rearrange columns by column name


in excel, you can easily write scripts to reorder and delete columns using just the column names (specified in the header row -- row 1) using the below vba macro i made.

for example, to make a simple macro that delete's the "name" column:

be sure to read the documentation in the comments to learn how to do more.


i'd love you to comment if this helped you or if you need help using the script.

Sub RearrangeColumns()
    If ConfirmFormat Then
    
        '==================================================================
        '
        ' type how you want to rearrange columns below.
        ' here's what you can do:
        '
        ' delete a column
        '    to delete the "site_dir1" column, type
        '    DeleteColumn "site_dir1"
        '
        ' move a column to a location specified by letter
        '    to move "pmt_descrp" to column "A", type
        '    MoveColumn "pmt_descrp", "A"
        '
        ' move a column before another column
        '    to move "pmt_class" before the "site_addrs" column, type
        '    MoveColumnBeforeOtherColumn "pmt_class", "site_addrs"
        '
        ' move a column after another column
        '    to move "site_addrs" after the "pmt_class" column, type
        '    MoveColumnAfterOtherColumn "site_addrs", "pmt_class"
        '
        ' then you have to run the macro on the spreadsheet and then save.
        '
        '==================================================================
        
        '........type here......

        


        
        '==================================================================
        '==================================================================
        
    End If
End Sub



Private Function ConfirmFormat() As Boolean
    Dim result As Boolean
    
    result = True

   ' you can use this function to make sure the spreadsheet
   ' you're working with didn't already have its columns
   ' reordered, or at least make sure it's the correct type of
   ' spreadsheet that your macro is made for.

   ' If Cells(1, 1) <> "expected name of column A" Then
   '     result = False
   ' End If
   ' 
   ' If Cells(1, 2) <> "price" Then
   '     result = False
   ' End If
   ' 
   ' If Cells(1, 3) <> "item name" Then
   '    result = False
   ' End If
   '
   ' If Cells(1, 4) <> "date" Then
   '     result = False
   ' End If
    
    If result = False Then
        MsgBox "this spreadsheet is not in the expected format.  you may have already re-ordered the columns in the spreadsheet."
    End If
    
    ConfirmFormat = result

End Function





'***************************************************************************************

'you do not need to change any code below to use this macro.


'***************************************************************************************



Function AddOne(ByRef lngN As Integer) As Integer
    lngN = lngN + 1
    AddOne = lngN

    ' this function let's you specify the order of columns you want sequentially,
    ' starting at column A, like so:
    '

    ' Dim nextNumber As Integer
    ' nextNumber = 1
    '
    ' MoveColumn "const_type", ColumnLetter(AddOne(nextNumber)) 'col A
    ' MoveColumn "site_cnty", ColumnLetter(AddOne(nextNumber)) 'col B
    ' MoveColumn "site_city", ColumnLetter(AddOne(nextNumber)) 'col C
    ' MoveColumn "site_stnam", ColumnLetter(AddOne(nextNumber)) 'col D

End Function

Private Sub DeleteColumn(ColumnName As String)
    DeleteColumn2 FindColumn(ColumnName)
End Sub

Private Sub MoveColumn(NameOfColumnToMove As String, MoveBeforeCols As String)
    MoveColumnBeforeOtherColumn2 FindColumn(NameOfColumnToMove), MoveBeforeCols
End Sub

Private Sub MoveColumnBeforeOtherColumn(NameOfColumnToMove As String, NameOfColumnToPutBefore As String)
    MoveColumnBeforeOtherColumn2 FindColumn(NameOfColumnToMove), FindColumn(NameOfColumnToPutBefore)
End Sub
Private Sub MoveColumnAfterOtherColumn(NameOfColumnToMove As String, NameOfColumnToPutAfter As String)
    MoveColumnBeforeOtherColumn2 FindColumn(NameOfColumnToMove), FindNextColumn(NameOfColumnToPutAfter)
End Sub

Private Sub DeleteColumn2(Cols As String) 'eg Cols = "A"
    Columns(Cols & ":" & Cols).Delete Shift:=xlToLeft
End Sub

Private Sub MoveColumnBeforeOtherColumn2(ColsToMove As String, MoveBeforeCols As String)
    If ColsToMove <> MoveBeforeCols Then
        Columns(ColsToMove & ":" & ColsToMove).Cut
        Columns(MoveBeforeCols & ":" & MoveBeforeCols).Insert Shift:=xlToRight
    End If
End Sub

Private Function FindColumnX(Name As String, Offset As Integer) As String
    Dim Col As String
    
    For i = 1 To 255
        If Cells(1, i) = Name Then
            Col = ColumnLetter(i + Offset)
            Exit For
        End If
    Next
    
    If Col = "" Then
        
        MsgBox "Can't find column '" & Name & "'.  Make sure you the spreadsheet is in the correct format."
    
        End 'stop processing spreadsheet
        
    End If
    
    FindColumnX = Col
    
End Function
Private Function FindColumn(Name As String) As String
    FindColumn = FindColumnX(Name, 0) 'offset = 0 means just find the column like normal
End Function
Private Function FindNextColumn(Name As String) As String
    FindNextColumn = FindColumnX(Name, 1) 'offset = 1 means get the column AFTER this column
End Function


'i got this ColumnLetter function from freevbcode.
'before you re-publish, check their licensing permissions page.
Function ColumnLetter(ByVal ColumnNumber As Integer) As String
        '
        'example usage:
        '
        'Dim temp As Integer
        'temp = Sheets(1).Range("B2").End(xlToRight).Column
        'MsgBox "The last column of this region is " & _
        '        ColumnLetter(temp)
        '
            
    If ColumnNumber <= 0 Then
        'negative column number
        ColumnLetter = ""
        
    ElseIf ColumnNumber > 16384 Then
        'column not supported (too big) in Excel 2007
        ColumnLetter = ""
        
    ElseIf ColumnNumber > 702 Then
        ' triple letter columns
        ColumnLetter = _
        Chr((Int((ColumnNumber - 1 - 26 - 676) / 676)) Mod 676 + 65) & _
        Chr((Int((ColumnNumber - 1 - 26) / 26) Mod 26) + 65) & _
        Chr(((ColumnNumber - 1) Mod 26) + 65)
    
    ElseIf ColumnNumber > 26 Then
        ' double letter columns
        ColumnLetter = Chr(Int((ColumnNumber - 1) / 26) + 64) & _
                Chr(((ColumnNumber - 1) Mod 26) + 65)
    Else
        ' single letter columns
        ColumnLetter = Chr(ColumnNumber + 64)
    
    End If
End Function

3 comments:

  1. Alex, Thankyou very much!

    You just saved me countless hours of my life, :D

    I appreciate the effort you put into the script.

    ReplyDelete
  2. Hi code given was working weell, But now code is interrupting where we delete any column or move any column, can you please help me .
    Private Sub MoveColumnBeforeOtherColumn2(ColsToMove As String,

    MoveBeforeCols As String)
    If ColsToMove <> MoveBeforeCols Then
    Columns(ColsToMove & ":" & ColsToMove).Cut
    Columns(MoveBeforeCols & ":" & MoveBeforeCols).Insert Shift:=xlToRight
    End If
    End Sub

    code automatically stops and sdaya code execution has been interrupted ,

    ReplyDelete
  3. Perfect, Thanks!

    ReplyDelete