VBA, changing Columns for Rows

F

Farback

Board Regular
Joined
Mar 27, 2009
Messages
149
I use this code to look down coumn C and to delete any row that had "Value A" or "Value" in it:

Sub Delete_Surplus_Rows()
Dim FindString As String
Dim iRow As Long
Dim LastRow As Long
Dim FirstRow As Long
Dim CalcMode As Long
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
FirstRow = 4
With ActiveSheet
.DisplayPageBreaks = False
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

For iRow = LastRow To FirstRow Step -1

If IsError(.Cells(iRow, "C").Value) Then
'Do nothing
'This avoids an error if there is a error in the cell
ElseIf .Cells(iRow, "C").Value = "Value A" Then
.Rows(iRow).Delete
ElseIf .Cells(iRow, "C").Value = "Value B" Then
.Rows(iRow).Delete
End If

Next iRow

End With
With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With
End Sub

In another spreadsheet, I now need to look along row 3 for two values, say "Value C" and "Value B", and to delete the columns that contain them. How do I amend my code to do this?
 

Excel Facts

Excel motto
Not everything I do at work revolves around Excel. Only the fun parts.
Sort by date Sort by votes
Try this:

Code: 
Sub Delete_Surplus_Columns()

Dim FindString As String
Dim iCol As Long, LastCol As Long, FirstCol As Long
Dim CalcMode As Long

With Application
    CalcMode = .Calculation
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
End With

FirstCol = 1
With ActiveSheet
    .DisplayPageBreaks = False
    
    LastCol = .Cells(3, Columns.Count).End(xlToLeft).Column
    
    For iCol = LastCol To FirstCol Step -1
    
        If IsError(.Cells(3, iCol).Value) Then
        'Do nothing
        'This avoids an error if there is a error in the cell
        ElseIf .Cells(3, iCol).Value = "Value B" Then
        .Columns(iCol).Delete
        ElseIf .Cells(3, iCol).Value = "Value C" Then
        .Columns(iCol).Delete
        End If
    
    Next iCol

End With

With Application
    .ScreenUpdating = True
    .Calculation = CalcMode
End With

End Sub
 
Upvote 0
Here's an alternative way which should make it easier to add more criteria. It also does all the deleting in one go and won't error if there are error cells in the range.

Code: 
Sub deleteCols()
    Dim delArray As Variant, delRange As Range, addr As String
    Dim str As Variant, found As Range, delCols As Range
    delArray = Array("Value A", "Value B")
    Set delRange = Rows(3)
    For Each str In delArray
        Set found = delRange.Find(what:=str)
        If Not found Is Nothing Then
            addr = found.Address
            Do
                If delCols Is Nothing Then
                    Set delCols = found
                Else
                    Set delCols = Union(delCols, found)
                End If
                Set found = delRange.FindNext(found)
            Loop While addr <> found.Address
        End If
    Next str
    If Not delCols Is Nothing Then delCols.EntireColumn.Delete
End Sub
 
Last edited:
Upvote 0
FAO Weaver, Re: VBA, changing Columns for Rows

You very kindly gave me the above code for deleting columns with certain stated values - "Value A", "Value B" etc - in row 3:

Is there a way of amending this to delete all columns with entries in column 3 EXCEPT those with certain values - "Value A", "Value B" etc?
<!-- / message -->
 
Upvote 0
try this:

change
Code: 
If Not delCols Is Nothing Then delCols.EntireColumn.Delete
to
Code: 
If Not delCols Is Nothing Then
    delCols.EntireColumn.Hidden = True
    delRange.SpecialCells(xlCellTypeVisible).EntireColumn.Delete
    Cells.EntireColumn.Hidden = False
End If
Although I should point out this won't work properly if there are columns hidden for other reasons, but you still want to delete them
 
Upvote 0
FAO Weaver Re: VBA, changing Columns for Rows

Your code works so well I adapted it back to use it to delete unwanted rows:
Sub deleteRows()
Dim delArray As Variant, delRange As Range, addr As String
Dim str As Variant, found As Range, delRows As Range
delArray = Array("Activity 1", "Activity 2")
Set delRange = Columns(3)
For Each str In delArray
Set found = delRange.Find(what:=str)
If Not found Is Nothing Then
addr = found.Address
Do
If delRows Is Nothing Then
Set delRows = found
Else
Set delRows = Union(delRows, found)
End If
Set found = delRange.FindNext(found)
Loop While addr <> found.Address
End If
Next str
If Not delRows Is Nothing Then
delRows.EntireRow.Hidden = True
delRange.SpecialCells(xlCellTypeVisible).EntireRow.Delete
Cells.EntireRow.Hidden = False
End If
End Sub
This works fine, except that it also deletes headings and the title row. What code would I add to only delete unwanted rows below Row 4?
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Solved
Hyperlink on VBA
Replies
2
Views
78
MSqueries
M
R
  • Solved
Macro To Move Files - Will Not Move .msg or .csv files
Replies
4
Views
104
rachel06
R
S
  • Question Question
User Form not Loading
Replies
5
Views
177
StevieMP
S
N
  • Question Question
AutoFilter Field Macro Returns a Header Row only
2
Replies
11
Views
206
MARK858
MARK858
K
  • Question Question
create fixtures but 2 vs 2
Replies
7
Views
171
kerm007
K

Forum statistics

Threads
1,224,521
Messages
6,179,286
Members
452,902
Latest member
Knuddeluff

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top