Deleting data in multiple columns based on set criteria

[Hannaford123]

Hi - I have a spreadsheet with multiple columns containing teaching staff (3 x initials), or non teaching staff (number 1). I want to delete all the number 1's and regroup each column so that there are no blanks. I can't do this by using a filter as it also works across the rows whereas I want the columns to remain independent of each other. Can I set this up on a macro so that all the cells containing the number 1 are deleted and the remaining cells in each column move up? I can do each column manually but with 50+ columns there must be an easier way!
Thanks

 

[drsarao]

Hi,
Welcome to Board!
Try this:
(ON A COPY PL!)

Sub DeleteNonTeachers()
lr = ActiveSheet.UsedRange.Rows.Count  'last row
lc = ActiveSheet.UsedRange.Columns.Count  'last column
For r = lr To 1 Step -1
    For c = lc To 1 Step -1
        If Cells(r, c).Value = 1 Then Cells(r, c).Delete xlShiftUp 'kill
    Next c
Next r
End Sub