![]() |
Macro Help PLEASE
With Columns("I:I")
On Error Resume Next ..Replace What:=0, Replacement:="#n/a", LookAt:=xlWhole ..SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.Delete End With This works for me but THE WOMAN AT THE OFFICE WOULD LIKE NOT TO DELETE COLUMNS WITH ZERO VALUES. BUT TO CUT AND PASTE THEM AT THE BOTTOM OF THE SHEET This only part of the whole Macro but this is the part that Deletes |
Macro Help PLEASE
Im sorry Its Rows Not Column to Delete
The Reason for this Is that this is a pick list for a ware house to pull orders and see what is out of stock "Mike" wrote: With Columns("I:I") On Error Resume Next .Replace What:=0, Replacement:="#n/a", LookAt:=xlWhole .SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.Delete End With This works for me but THE WOMAN AT THE OFFICE WOULD LIKE NOT TO DELETE COLUMNS WITH ZERO VALUES. BUT TO CUT AND PASTE THEM AT THE BOTTOM OF THE SHEET This only part of the whole Macro but this is the part that Deletes |
Macro Help PLEASE
Hard to make a firm recommendation without seeing the whole macro - but I
think this will give you an idea. First we have to realize that the zero values may be randomly placed in column I, and so it would probably be a bit klutzy looking to do a select that would copy them and paste down at the bottom because there would probably be big gaps between them then. This leads us to having to look at each cell used in I and copying/pasting as we hit ones of interest. The following code, while not as eloquent as some could probably come up with, is functional. Sub FindAndMoveZeros() 'looks in column I for zeros 'moves entire row to bottom of list 'deletes the found row 'repeats until no zero is found 'If data starts in cell other than I2 as 'presumed, change ' Const StartOfData = "I2" 'to reference the first cell to be examined Const SOD = "I2" ' SOD short for "Start Of Data" Dim EmptyRow As Long Dim MovedCount As Long Dim LC As Long ' loop control 'find first empty row 'which after a row delete will always 'be the current last used row EmptyRow = Range("I" & Rows.Count).End(xlUp).Row + 1 Application.ScreenUpdating = False ' for performance Do Until (MovedCount + LC) = EmptyRow If Range(SOD).Offset(LC, 0) = 0 Then Rows(Range(SOD).Offset(LC, 0).Row & _ ":" & Range(SOD).Offset(LC, 0).Row).Copy Rows(EmptyRow & ":" & EmptyRow).Select ActiveSheet.Paste Rows(Range(SOD).Offset(LC, 0).Row & ":" & _ Range(SOD).Offset(LC, 0).Row).Delete Shift:=xlUp MovedCount = MovedCount + 1 LC = LC - 1 Else LC = LC + 1 End If Loop Range(SOD).Select Application.ScreenUpdating = True End Sub "Mike" wrote: With Columns("I:I") On Error Resume Next .Replace What:=0, Replacement:="#n/a", LookAt:=xlWhole .SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.Delete End With This works for me but THE WOMAN AT THE OFFICE WOULD LIKE NOT TO DELETE COLUMNS WITH ZERO VALUES. BUT TO CUT AND PASTE THEM AT THE BOTTOM OF THE SHEET This only part of the whole Macro but this is the part that Deletes |
Macro Help PLEASE
Mike,
I figured you meant rows, not column and wrote the code accordingly in my other response. You can take that code and stick it into the section of your macro that is doing the find/replace right now - it doesn't have to be a separate routine, although you could just copy the whole thing as a Sub and then call it from your current macro, replacing all of the With...End With statements with a one-line call to it. "Mike" wrote: Im sorry Its Rows Not Column to Delete The Reason for this Is that this is a pick list for a ware house to pull orders and see what is out of stock "Mike" wrote: With Columns("I:I") On Error Resume Next .Replace What:=0, Replacement:="#n/a", LookAt:=xlWhole .SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.Delete End With This works for me but THE WOMAN AT THE OFFICE WOULD LIKE NOT TO DELETE COLUMNS WITH ZERO VALUES. BUT TO CUT AND PASTE THEM AT THE BOTTOM OF THE SHEET This only part of the whole Macro but this is the part that Deletes |
All times are GMT +1. The time now is 05:43 AM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com