Share via

Cells appear empty but sort returns blank rows at top

Anonymous
2013-05-30T11:37:11+00:00

I have a macro which pastes formulas as values, deletes empty rows and sorts data. But... I keep getting blank rows at the top and however much data is remaining (different on each worksheet), it always ends on row 298. On all 3 worksheets there are headings in row 1 and formulas in rows 2 to 500. If the formulas return no data they result in #REF1, hence the code to remove these.

The code below has got a bit scrappy because I've been going round in circles. I must be missing something obvious.

'Paste all data as values on 'DM' Worksheet

    Sheets("DM").Select

    With Range("A:K")

        .Cells.Copy

        .Cells.PasteSpecial xlPasteValues

        .Cells(1).Select

    End With

 'Sort by Job No'DM' Worksheet

    Worksheets("DM").Select

    Range("A1").Select

    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select

    Selection.Sort Key1:=Range("C2"), Order1:=xlAscending, Header:=xlGuess, _

    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _

    DataOption1:=xlSortNormal

    Range("A:K").Select

    Selection.Replace What:="#REF!", Replacement:="", LookAt:=xlPart, _

    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _

    ReplaceFormat:=False

'Delete empty rows from 'DM' sheet

    Range("DM_ColA").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

'Paste all data as values on 'JC' Worksheet

    Sheets("JC").Select

    With Range("A:K")

        .Cells.Copy

        .Cells.PasteSpecial xlPasteValues

        .Cells(1).Select

    End With

    Range("A:K").Select

    Selection.Replace What:="#REF!", Replacement:="", LookAt:=xlPart, _

    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _

    ReplaceFormat:=False

 'Sort by Job No'JC' Worksheet

    Worksheets("JC").Select

    Range("A1").Select

    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select

    Selection.Sort Key1:=Range("C2"), Order1:=xlAscending, Header:=xlGuess, _

    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _

    DataOption1:=xlSortNormal

'Delete empty rows from 'JC' sheet

    Range("JC_ColA").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

'Paste all data as values on 'TG' Worksheet

    Sheets("TG").Select

    With Range("A:K")

        .Cells.Copy

        .Cells.PasteSpecial xlPasteValues

        .Cells(1).Select

    End With

    Range("A:K").Select

    Selection.Replace What:="#REF!", Replacement:="", LookAt:=xlPart, _

    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _

    ReplaceFormat:=False

 'Sort by Job No'TG' Worksheet

    Worksheets("TG").Select

    Range("A1").Select

    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select

    Selection.Sort Key1:=Range("C2"), Order1:=xlAscending, Header:=xlGuess, _

    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _

    DataOption1:=xlSortNormal

'Delete empty rows from 'TG' sheet

    Range("TG_ColA").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

Ranges DM_ColA, JC_ColA & TG_ColA are cells A1:A500 on each worksheet.

Microsoft 365 and Office | Excel | For home | Windows

Locked Question. This question was migrated from the Microsoft Support Community. You can vote on whether it's helpful, but you can't add comments or replies or follow the question.

0 comments

1 answer

Sort by: Most helpful
Most helpful Newest Oldest
  1. Anonymous
    2013-05-31T10:01:45+00:00

    It is easier if you use sub calls and refer the object directly.

    If the problem with the blank cells persists, check the contents of the cells. In most cases those cells contains on or more blanks and/or an apostrohe, which are invisible on screen.

    Andreas.

    Option Explicit

    Sub Main()

      Dim Ws

      For Each Ws In Array("DM", "JC", "TG")

        MyDel Ws

      Next

    End Sub

    Sub MyDel(ByVal WsName As String)

      Dim R As Range

      With Worksheets(WsName)

        'Get the last used cell

        Set R = .Cells.SpecialCells(xlCellTypeLastCell)

        'Access columns A:K until the row of this cell

        With .Range("A1:K" & R.Row)

          'Change formulas to values

          .Value = .Value

          'Remove broken references

          .Replace What:="#REF!", Replacement:="", LookAt:=xlPart

          'Sort the data

          .Sort Key1:=.Range("C2"), Header:=xlYes

        End With

        'Delete rows if empty cells in column A

        On Error Resume Next

        .Range("A1:A" & R.Row).SpecialCells(xlCellTypeBlanks).EntireRow.Delete

      End With

    End Sub

    Was this answer helpful?

    0 comments