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:
- create a new visual basic macro
- paste in the below code to the new module
- type DeleteColumn "name" in the RearrangeColumns function
- run the macro, RerrangeColumns.
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
Alex, Thankyou very much!
ReplyDeleteYou just saved me countless hours of my life, :D
I appreciate the effort you put into the script.
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 .
ReplyDeletePrivate 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 ,
Perfect, Thanks!
ReplyDelete