Thanks excelledsoftware - I tried moving the code around as you suggested but not working - Below is a full revised version of line of code that you should be able to test with. I greatly appreciate your help. Thanks
Sub Report()
'IMPORTANT this code will DELETE data from a worksheet.
Dim c As Variant
Dim LastPasteRow As Long, FinalRow As Long, DataRows As Long
FinalRow = 30000 'Change this to the choice of final row of data.
On Error GoTo Clipboardempty
Range("A1").Select
ActiveSheet.Paste
On Error GoTo 0 'return errors back to normal.
'Run a loop to find the last row
For Each c In Selection
LastPasteRow = c.Row
Next c
DataRows = WorksheetFunction.CountA(Range(LastPasteRow + 1 & ":" & FinalRow))
If DataRows = 0 Then
End 'Ends the program because nothing is below
Else
'This is the command that deletes everything below.
Range(LastPasteRow + 1 & ":" & FinalRow).ClearContents
End If
'NEXT clean data to generate report
'To remove the * from the file
Sheets("DATA").Select
Range("QueryData").Select
Columns("F:F").Select
Selection.Replace What:="~*", Replacement:="", LookAt _
:=xlPart, SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:= _
False, ReplaceFormat:=False
'To Custom Sort the Subcategories in the right order needed in the Reports
ActiveWorkbook.Worksheets("DATA").Sort.SortFields. Clear
ActiveWorkbook.Worksheets("DATA").Sort.SortFields. Add Key:=Range("F:F"), _
SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
"Banana,Apple,Tomatoes,Spices" _
, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("DATA").Sort
.SetRange Range("QueryData")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'This refreshes all Pivot Table Element for Report
ActiveWorkbook.RefreshAll
'This is to autofit the sheet
Set mysheet = ActiveSheet
For Each Sheet In Worksheets
Sheet.Select
Cells.EntireColumn.AutoFit
Next Sheet
mysheet.Select
'To select the first cell
Sheets("Sort").Select
End
Clipboardempty:
'Checks if the clipboard is empty and if so halts execution
MsgBox "Nothing to paste, program ending."
End
End Sub
|