delete alternate columns...

[Guest]

Need a macro/function that'll delete every other column.
THX
Scottie

 

[Vasant Nanavati]

Something like:

Sub DeleteAltCols()
Dim i As Integer
For i = Columns.Count To 1 Step -1
If i Mod 2 = 0 Then Cells(1, i).EntireColumn.Delete
Next
End Sub

 

[Bob Phillips]

answered in .misc.

If posting to multiple groups, best to do it in a single post, not multiple
postings.

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

 

[Ken Wright]

This will delete Col B, D, F etc onwards to the end of your data. If you want
A, C, E etc to go, then change the 2 to a 1 in teh line For x = 2 To lc (to
For x = 1 To lc)

Sub DelCols()

Dim LastCol As Integer
Dim lc As Integer
Dim x As Integer

Application.ScreenUpdating = False

LastCol = ActiveSheet.UsedRange.Column - 1 + _
ActiveSheet.UsedRange.Columns.Count

lc = Int(LastCol / 2)

For x = 2 To lc
ActiveSheet.Columns(x).Delete
Next x

Application.ScreenUpdating = True

End Sub

 

[J.E. McGimpsey]

one way:

Public Sub DelEveryOtherColumn()
Dim result As Integer
Dim cell As Range
Dim delRange As Range
Dim i As Integer
Dim refStr1 As String
Dim refStr2 As String
If Application.ReferenceStyle = xlR1C1 Then
refStr1 = "1"
refStr2 = "2"
Else
refStr1 = "A"
refStr2 = "B"
End If
result = MsgBox(prompt:="Start with Column " & _
refStr1 & "?" & vbNewLine & vbNewLine & _
"Click ""Yes"" for " & refStr1 & ", ""No"" for " & _
refStr2, Title:="Delete Alternate Columns", _
Buttons:=vbYesNoCancel)
If result = vbCancel Then Exit Sub
Set delRange = Cells(1, 2 + (result = vbYes))
For i = delRange.Column + 2 To _
Cells.SpecialCells(xlCellTypeLastCell).Column Step 2
Set delRange = Union(delRange, Cells(1, i))
Next i
delRange.EntireColumn.Delete
ActiveSheet.UsedRange
End Sub

 

[Scottie]

Sorry...

-----Original Message-----
answered in .misc.

If posting to multiple groups, best to do it in a single post, not multiple
postings.

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)




.