Joe,

I'm not sure which function you are after exactly. Here is my entire
macro.. It may not be the tidiest code in the world, but it's doing the job..
Hope it helps you -kelli


Sub CullSort()
'

'Copies and Pastes values for entire sheet to eliminate formulas
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False




'Sorts by "Master" (Column P) so that following removal sequence runs faster
Cells.Select
Selection.Sort Key1:=Range("P2"), Order1:=xlDescending, Header:=xlGuess,
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom,
DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:= _
xlSortNormal




'Removes entire row for unwanted records based on calculated formulas in
Column P
Dim rng As Range
Dim rCell As Range
Dim delRng As Range
Dim WB As Workbook
Dim SH As Worksheet
Dim CalcMode As Long

Set WB = ActiveWorkbook

Set SH = WB.Sheets("Prelim")
Set rng = Intersect(SH.UsedRange, SH.Columns("P:P"))

On Error GoTo XIT
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

For Each rCell In rng.Cells
If rCell.Value = "DELETE" Then
If delRng Is Nothing Then
Set delRng = rCell
Else
Set delRng = Union(rCell, delRng)
End If
End If
Next rCell

If Not delRng Is Nothing Then
delRng.EntireRow.Delete
End If

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



' Blanks out zero quantities in all Qty columns (note to self: there is
probably a faster way to do this)
Dim list As Integer
For list = 1 To 20000
If Cells(list, 8) = "0" Then
Cells(list, 8) = ""
End If
If Cells(list, 9) = "0" Then
Cells(list, 9) = ""
End If
If Cells(list, 11) = "0" Then
Cells(list, 11) = ""
End If
If Cells(list, 12) = "0" Then
Cells(list, 12) = ""
End If
Next
'


'Removes now unnecessary formula columns and pastes some results over
original data
Columns("T:T").Select
Selection.Cut
Columns("N:N").Select
ActiveSheet.Paste
Columns("C:C").Select
Selection.Delete Shift:=xlToLeft
Columns("O:R").Select
Selection.Delete Shift:=xlToLeft

Range("A1").Select




'Copies all rows where B is not empty and pastes values in pre-existing sheet2
Dim FirstCell As Range
Dim LastCell As Range
Dim destRng As Range

Set destRng = WB.Sheets("Buyer").Range("A2")
If Not IsEmpty(SH.Range("B2")) Then
Set FirstCell = SH.Range("A2")
Else
Set FirstCell = SH.Range("A2").End(xlDown)
End If
Set LastCell = SH.Cells(Rows.Count, "B").End(xlUp)
SH.Range(FirstCell, LastCell).EntireRow.Copy
destRng.PasteSpecial Paste:=xlPasteValues,
Operation:=xlPasteSpecialOperationNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False


'Formats and sorts "Buyer" sheet
Sheets("Buyer").Select
Cells.Select
Selection.Columns.AutoFit
Set tbl = ActiveCell.CurrentRegion
tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, tbl.Columns.Count).Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending,
Key2:=Range("C2"), Order2:=xlAscending, Key3:=Range("D2"),
Order3:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal,
DataOption2:=xlSortNormal, DataOption3:= _
xlSortNormal
Range("A2").Select


'Duplicates "Buyer" data in "Floor" sheet
Sheets("Buyer").Select
Set destRng = WB.Sheets("Floor").Range("A1")
Cells.Select
Selection.Copy
destRng.PasteSpecial xlPasteAll, xlPasteSpecialOperationNone,
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False


'Deletes entire row in "Floor" for records when H is blank or < 0
Dim ViewMode As Long
Dim rngCurrentCell As Range
Dim rowDel As Range

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

ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView


Sheets("Floor").Select
Range("A2").Select

With ActiveSheet
.DisplayPageBreaks = False

Set tbl = ActiveCell.CurrentRegion
tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, tbl.Columns.Count).Select


For Each rngCurrentCell In Worksheets("Floor").Range("H:H").Cells
If IsEmpty(rngCurrentCell) Or rngCurrentCell.Value < 0.01 Or
rngCurrentCell.Value = "" Then
If rowDel Is Nothing Then
Set rowDel = rngCurrentCell
Else
Set rowDel = Application.Union(rowDel, rngCurrentCell)
End If
End If

Next
End With

If Not rowDel Is Nothing Then
rowDel.EntireRow.Delete
End If

ActiveWindow.View = ViewMode
With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With


Range("A2").Select


Sheets("Buyer").Select
Range("A2").Select

Sheets("Prelim").Delete

End Sub


"jkrist46" wrote:

Can you send me this. I have to do the same thing except cut it into another
worksheet tab.
Thanks Joe

KelliInCali wrote:
Norman... If it's not too presumptuous of me, may I ask one more favor? I
now just need to select and copy all rows for which B is populated. At this
point, all the records with data in B are grouped and there are no empty rows
after the last record. You've been great and I really appreciate the help!
-kelli

Hi Kelli,

[quoted text clipped - 60 lines]
empties the non-empty empty cells? Does knowtrumps code do that?
-Tks guys!