[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
?
Solved

delete and reorder columns

Posted on 2009-12-20
13
Medium Priority
?
496 Views
Last Modified: 2012-06-27
In this sheet I want to keep only cols labled Date-time, ADTP, ADTE, ADTD, ADTX and ADTS. The rest should be deleted. These cols should be  ordered left to right, for doing a stacked chart later .

This should be done in Excel Macro VBA
0
Comment
Question by:derekackerman
  • 8
  • 5
13 Comments
 

Author Comment

by:derekackerman
ID: 26091816
Here is a screen shot of the data sheet
Table.bmp
0
 
LVL 5

Expert Comment

by:syeager305
ID: 26092117
Sub Test()
Dim lcol, myarray, m As Variant

myarray = Array("ADTP", "ADTE", "ADTD", "ADTX", "ADTS", "Date-Time")
lcol = ActiveSheet.UsedRange.Columns.Count

For i = 1 To ActiveSheet.UsedRange.Columns.Count
    For m = LBound(myarray) To UBound(myarray)
        If myarray(m) = Cells(1, i).Value Then
            GoTo nexti:
        End If
    Next m
    Cells(1, i).Select
    With Selection
     .Delete
    End With
nexti:
Next i
   

 
End Sub
0
 
LVL 5

Expert Comment

by:syeager305
ID: 26092206
okay... sorry the first one was incomplete... I forgot to sort them, but this has a sort as well... =)


Sub DeleteandReorder()
Dim lcol, myarray, m As Variant
''delete columns
myarray = Array("Date-time", "ADTP", "ADTE", "ADTD", "ADTX", "ADTS")
lcol = ActiveSheet.UsedRange.Columns.Count

For i = 1 To ActiveSheet.UsedRange.Columns.Count
    For m = LBound(myarray) To UBound(myarray)
        If myarray(m) = Cells(1, i).Value Then
            GoTo nexti:
        End If
    Next m
    Cells(1, i).Select
    With Selection
     .Delete
    End With
nexti:

Next i
    For m = 1 To lcol
        For n = m To lcol
                If UCase(Cells(1, n).Value) > UCase(Cells(1, m).Value) Then
                    Columns(n).Select
                    Selection.Cut
                    Columns(m).Select
                    Selection.Insert Shift:=xlToRight
                End If
        Next n
    Next m
 
End Sub
0
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

Author Comment

by:derekackerman
ID: 26092538
I tried it, and the 1st part deletes ALL cells in Row 1 (1 at a time) It should delete entire cols whose headers are not in the array.

Dim lcol, myarray, m As Variant
''delete columns
myarray = Array("Date-time", "ADTP", "ADTE", "ADTD", "ADTX", "ADTS")
lcol = ActiveSheet.UsedRange.Columns.Count
MsgBox ("lcol = " & lcol & " " & LBound(myarray) & " " & UBound(myarray))

For i = 1 To ActiveSheet.UsedRange.Columns.Count
    For m = LBound(myarray) To UBound(myarray)
         If myarray(m) = Cells(1, i).Value Then
            GoTo nexti:
        End If
    Next m
    MsgBox ("i = " & i)
    Cells(1, i).Select    <============= ????
    With Selection
     .Delete
    End With
nexti:

Next i
MsgBox ("m = " & m)
0
 

Author Comment

by:derekackerman
ID: 26092581
Ignore my last update, this is how the sheet ends up
Table.bmp
0
 

Author Comment

by:derekackerman
ID: 26092606
this is how it should end up
Table-good.bmp
0
 
LVL 5

Expert Comment

by:syeager305
ID: 26093468
Okay, it's kind of tricky without your workbook... this should work now,

Sub DeleteandReorder()
Dim lcol, myarray, m As Variant
''delete columns
myarray = Array("Date-time", "ADTP", "ADTE", "ADTD", "ADTX", "ADTS")
lcol = ActiveSheet.UsedRange.Columns.Count

For i = 1 To lcol
    For a = LBound(myarray) To UBound(myarray)
        If myarray(a) = Cells(1, i).Value Then
            GoTo nexti:
        End If
    Next a
Columns(i).Select
    With Selection
        .Delete
        i = i - 1
        j = j + 1
        If j = lcol Then Exit For
    End With
nexti:
a = 0
Next i
    For m = 1 To lcol
        For n = m To lcol
                If UCase(Cells(1, n).Value) > UCase(Cells(1, m).Value) Then
                    Columns(n).Select
                    Selection.Cut
                    Columns(m).Select
                    Selection.Insert Shift:=xlToRight
                End If
        Next n
    Next m
 
End Sub
0
 

Author Comment

by:derekackerman
ID: 26093584
this one deleted everything, please test with  tab RangeTrd
Sample03-01-05.xlsx
0
 
LVL 5

Expert Comment

by:syeager305
ID: 26093763
Oh, the headings were being "padded" on the right, I added a trim function which removed the padding, and tested it in the spreadsheet you gave me and it worked.


Sub DeleteandReorder()
Dim lcol, myarray, m As Variant
''delete columns
myarray = Array("Date-time", "ADTP", "ADTE", "ADTD", "ADTX", "ADTS")
lcol = ActiveSheet.UsedRange.Columns.Count

For i = 1 To lcol
    For a = LBound(myarray) To UBound(myarray)
        If myarray(a) = Trim(Cells(1, i).Value) Then
            GoTo nexti:
        End If
    Next a
Columns(i).Select
    With Selection
        .Delete
        i = i - 1
        j = j + 1
        If j = lcol Then Exit For
    End With
nexti:
a = 0
Next i
    For m = 1 To lcol
        For n = m To lcol
                If UCase(Cells(1, n).Value) > UCase(Cells(1, m).Value) Then
                    Columns(n).Select
                    Selection.Cut
                    Columns(m).Select
                    Selection.Insert Shift:=xlToRight
                End If
        Next n
    Next m
 
End Sub



Sample03-01-05-2-.xls
0
 

Author Comment

by:derekackerman
ID: 26093834
the stmt: myarray = Array("Date-time",  was lower case t in time, I changed it to T and the col was not deleted. The only other thing is to order the result so
col B = ADTP
col C = ADTE
col D = ADTD
col E =  ADTX
col F = ADTS
0
 
LVL 5

Accepted Solution

by:
syeager305 earned 2000 total points
ID: 26093936
Oh, I thought you wanted it alphabetical... I dont' know where I got that from... sorry... the order will always be however you order the myarray...

Sub DeleteandReorder()

Dim lcol, myarray, m As Variant
''delete columns
myarray = Array("Date-time", "ADTP", "ADTE", "ADTD", "ADTX", "ADTS")
lcol = ActiveSheet.UsedRange.Columns.Count

For i = 1 To lcol
    For a = LBound(myarray) To UBound(myarray)
        If myarray(a) = Trim(Cells(1, i).Value) Then
            GoTo nexti:
        End If
    Next a
Columns(i).Select
    With Selection
        .Delete
        i = i - 1
        j = j + 1
        If j = lcol Then Exit For
    End With
nexti:
a = 0
Next i
    For n = 1 To lcol
   
        For m = LBound(myarray) To UBound(myarray)
            If myarray(m) = Trim(Cells(1, n).Value) And (m + 1) <> n Then
                Columns(n).Select
                Selection.Cut
                Columns(m + 1).Select
                Selection.Insert Shift:=xlToRight
            End If
        Next m
    Next n


 
End Sub
0
 

Author Comment

by:derekackerman
ID: 26094000
That's a winner!!!
0
 

Author Closing Comment

by:derekackerman
ID: 31668296
:)
0

Featured Post

VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Excel can be a tricky bit of software to get your head around. Whilst you’ll be able to eventually get to grips with the basic understanding of how to get by, there are a few Excel tips that not everybody will even know about let alone know how to d…
After seeing numerous questions for Dynamic Data Validation I notice that most have used Visual Basic to solve the problem. This suggestion is purely formula based and can be used in multiple rows.
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…

872 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question