Home » Forums » Open Source Learning Center » Question and Answer

How can I delete extra columns of data

Submitted by jbeeman on 26 July, 2011 - 04:24

How can I delete all the "MV" columns in the attached excel workbook - they are in random places throughout the workbook - but the columns I want deleted all have the word--- MV in the cell. I highlighted a few of the columns in yellow as my example. Once I delete them from the workbook, I want to copy them to a new sheet - only showing the MV columns?

Here is my file..thank you Jennifer

AttachmentSize
test(1).xls986.5 KB
‹ Emptying textboxes in a VBA form using a for next loop Tree View ›
»
Vishesh's picture

Del Xtra Col

Submitted by Vishesh on 26 July, 2011 - 06:03.
Paste the following code in a general module and make the necessary changes to the sheet name and range as per your requirement. 
Sub RunMe()
    Dim rngMV As Range
 
    'Set MV in a range
    Set rngMV = rngFindAll("MV", Sheet1.UsedRange)
 
    'Copy MV to another sheet i.e. sheet2
    rngMV.EntireColumn.Copy Sheet2.Range("A1")
 
    'Delete all MV columns
    rngMV.EntireColumn.Delete
 
    Set rngMV = Nothing
End Sub
 
Function rngFindAll(strFindWhat As String, rngFindIn As Range) As Range
    Dim arrOrgData
    Dim strBlankChar As String
    On Error GoTo 0
 
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
 
    If rngFindIn.Cells.Count = 1 Then
        If strFindWhat = rngFindIn.Value Then
            Set rngFindAll = rngFindIn
        Else
            Set rngFindAll = Nothing
        End If
        GoTo ExitH
    End If
    strBlankChar = "A-A-AB" 'Can be anything that is unlikely to be found in the range
    arrOrgData = rngFindIn 'Save Range to array
On Error Resume Next
    With rngFindIn
        .SpecialCells(xlCellTypeBlanks).Value = strBlankChar 'Change Blanks to other char (Temporarily)
        .Replace strFindWhat, vbNullString, xlWhole 'Replace the Find string with Blank
        If .Cells.Count = 1 Then
            If .Value = strFindWhat Then
                Set rngFindAll = rngFindIn
            End If
        Else
            Set rngFindAll = .SpecialCells(xlCellTypeBlanks) 'Find all blanks
        End If
    End With
On Error GoTo 0
    rngFindIn = arrOrgData 'Restore range from array
    On Error Resume Next
    Erase arrOrgData
    On Error GoTo 0
ExitH:
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
End Function
»