how to delete columns in a pattern.

[Zeema]

am trying to delete few columns in a pattern.
the pattern is a set of 9 columns; first set is from column Q:Y and my data range spreads till column BVI.
I want to keep the first two columns with column with 15 and delete the next 7 columns from each set.

I have tried the following, but it is extremely slow.
Sub DeleteColumnSlow()
If (MsgBox("Ready to delete columns?", vbYesNo) = vbYes) Then
Dim X As Integer
Dim Mad As Variant
Dim srtC As Variant
Dim EndC As Variant

X = InputBox("number of loops to run")

Mad = 1
srtR = 9
srtC = 19
EndC = 100

Do While (Mad < X)
Set MR = Range(Cells(srtR, srtC), Cells(srtR, EndC))
For Each cell In MR
If cell.Value = "Delete" Then cell.EntireColumn.Delete
Next

Mad = Mad + 1
Loop
MsgBox "update complete, Check updates."
Else: MsgBox "complete sample formatting and then run update"
End If

End Sub


Any help is greatly appreciated.
thanks
Zeema

 

[Zeema]

I have tried the following, but its messing up the columns from the second set...
I need to write it from the back... please help
Dim ws As Worksheet
Set ws = ActiveSheet

Dim i As Long

With ws
For i = 17 To 43 Step 9 ' length of the pattern block
With Cells(1, i)
.ColumnWidth = 15
.Offset(, 0).Resize(, 2).ColumnWidth = 15 'to hide set ColumnWidth = 0
.Offset(, 2).Resize(, 7).EntireColumn.Delete 'effect next seven columns,
End With
Next i
End With
End Sub

 

[Joe4]

When looping through ranges and deleting rows or columns, it is always best to loop through your range backwards, as deleting rows and columns will shift the ranges that you haven't hit yet, which can really messing things up, or skip over certain sections.

So, if you wanted to loop through columns 17 to 44 (by the way, 17 to 43 is NOT a multiple of 9) backwards, you would do it like this:

For i = 44 to 17 Step -9

Also, note that loops are notoriously slow and memory hogs! But one thing you can do to help speed up any VBA code is to suppress screen updating while the code is running.
So, at the very top of your code (under your "Sub..." line), you can add a line like this to temporary suspend screen updating:

Application.ScreenUpdating = False

and then you can turn it back on at the end of your code (before the "End Sub" line) like this:

Application.ScreenUpdating = True

Just make sure to turn it on in any other section that may exit your code before the "End Sub" line (i.e. if you have "Exit Sub" rows).

 

[Zeema]

Thank you So much... my code is working now...

Dim i As Long

With ws
For i = 44 To 25 Step -9 ' length of the pattern block, going backwards
With Cells(1, i)
.Offset(, -7).Resize(, 7).ColumnWidth = 2 'to hide set ColumnWidth = 0

End With
Next i
End With
End Sub

 

[Joe4]

Excellent!

If you add that tip I told you about with "ScreenUpdating", you may notice your code running faster.

 

[Zeema]

Excellent!

If you add that tip I told you about with "ScreenUpdating", you may notice your code running faster.

thank you... i have included that as well.
final version
Sub Delete_ColumnWidth_BackwardsTest()
If (MsgBox("Ready to delete columns?", vbYesNo) = vbYes) Then

Application.ScreenUpdating = False ' to make the macro run faster

Dim ws As Worksheet
Dim wb As Workbook

Set ws = ActiveSheet

Dim i As Long

With ws
For i = 44 To 25 Step -9 ' length of the pattern block, 9 columns to the left, going backwards. effecting column 17:43 range
With Cells(1, i)
.Offset(, -9).Resize(, 2).ColumnWidth = 15 'effects first two columns of the set.
.Offset(, -7).Resize(, 7).EntireColumn.Delete 'deletes 7 columns to left from column 44. to hide set ColumnWidth = 0

End With
Next i
End With

Application.ScreenUpdating = True

MsgBox "update complete, Check updates"
Else: MsgBox "check code and formating and then run update"
End If
End Sub