Strange Sort
 

I have a strange thing I want my macro to do. A: Search Column I for a 7 or
a 1 and if it is not one of those two then delete columns E through J in that
row and shift all data to right over into it's place. This formula below is
CLOSE, but not quite. It does it some of the time, but for some reason it
leaves a 5 or a D. I want this formula to run some kind of loop to keep
doing the search until the column I is filled with 7, 1, or blank. Then run
the program loop again except on column O, looking for just 1's. Deleting
everything from K Through P if it doesn't have a 1 shifting all data to the
right into it's place and loop until there is nothing but 1's or blanks left.


Dim lastrow As Long, a As Long
Dim cell As Range

lastrow = Cells(Rows.Count, "I").End(xlUp).Row
For i = lastrow To 1 Step -1
Set cell = Cells(i, "I")
If IsNumeric(cell) Then
If Not (cell = 1 Or cell = 7) Then
cell.Offset(0, -4).Resize(1, 6).Delete Shift:=xlToLeft
End If
End If
Next

I know it's kind of wierd, don't ask because I'm not typing the novel it
takes to understand. :) Does it make sense what I want it to do? Any help
is MUCH appreciated. THANKS!!!!!

Strange Sort
 

Slight Correction:

I DO want it to leave a D also. The things I want it to keep and not delete
are 7, 1, D, 8. I want the 5 sections to be deleted. Sorry for the
amendment.

"bodhisatvaofboogie" wrote:

I have a strange thing I want my macro to do. A: Search Column I for a 7 or
a 1 and if it is not one of those two then delete columns E through J in that
row and shift all data to right over into it's place. This formula below is
CLOSE, but not quite. It does it some of the time, but for some reason it
leaves a 5 or a D. I want this formula to run some kind of loop to keep
doing the search until the column I is filled with 7, 1, or blank. Then run
the program loop again except on column O, looking for just 1's. Deleting
everything from K Through P if it doesn't have a 1 shifting all data to the
right into it's place and loop until there is nothing but 1's or blanks left.


Dim lastrow As Long, a As Long
Dim cell As Range

lastrow = Cells(Rows.Count, "I").End(xlUp).Row
For i = lastrow To 1 Step -1
Set cell = Cells(i, "I")
If IsNumeric(cell) Then
If Not (cell = 1 Or cell = 7) Then
cell.Offset(0, -4).Resize(1, 6).Delete Shift:=xlToLeft
End If
End If
Next

I know it's kind of wierd, don't ask because I'm not typing the novel it
takes to understand. :) Does it make sense what I want it to do? Any help
is MUCH appreciated. THANKS!!!!!