# Excel macro selection range



## Gram123 (Mar 15, 2001)

Hello,
I have a macro which performs a series of tasks on a document I receive from another company. It works fine, but I want to add in a sort order.

The file can have differing numbers of rows in it, so I figured the easiest thing was to use a selection range that would always be higher than the maximum number of rows (in this case 5000 rows).
However, when I sort, I get a whole bunch of empty rows ahead of my data.

Another point is that it's not the tidiest file and can have stray cells with fill colours or borders on them and if you CTRL+END the last cell can be thousands of cells away from the data.

So my problem is twofold:
1) How do I reset the last cell within my macro?
2) How do I limit the selection range not to 5000 cells, but to the proper cell range that contains the appropriate data?

Here's my macro as it stands:

Sub PrepareDICO()
ActiveWindow.FreezePanes = False
If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
Cells.Select
Range("A1").Activate
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.Replace What:="_", Replacement:=" ", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="-", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Columns("D").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Range("S4:S5000,W4:Z5000,AB4:AC5000").Select
Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("A1").Select
Application.Goto Reference:="R3C4:R5000C34"
ActiveWindow.SmallScroll ToRight:=4
Selection.Cut Destination:=Range("H3:AL5000")
Range("H3:AL5000").Select
ActiveWindow.SmallScroll Down:=-15
Range("A1").Select
Application.Goto Reference:="R4C4"
ActiveCell.FormulaR1C1 = "=TRIM(RC[4])"
Range("D4").Select
Selection.AutoFill Destination:=Range("D4:G4"), Type:=xlFillDefault
Range("D4:G4").Select
Selection.AutoFill Destination:=Range("D4:G5000"), Type:=xlFillDefault
Range("D4:G5000").Select
Application.Goto Reference:="R4C4:R5000C7"
Selection.Copy
ActiveWindow.SmallScroll Down:=-15
Range("H4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("D:E").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Range("D4").Select
ActiveCell.FormulaR1C1 = "=RC[2]&RC[4]"
Range("D4").Select
Selection.AutoFill Destination:=Range("D4:E4"), Type:=xlFillDefault
Range("D4:E4").Select
Selection.AutoFill Destination:=Range("D4:E5000"), Type:=xlFillDefault
Range("D4:E5000").Select
Columns("D:E").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("D3").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "French Code"
Range("E3").Select
ActiveCell.FormulaR1C1 = "UK Code"
Range("A3").Select
Selection.Copy
Range("D3:E3").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Cells.Select
Application.Goto Reference:="R4C1:R5000C36"
ActiveWindow.SmallScroll Down:=-18
Application.Goto Reference:="R4C4:R5000C5"
Selection.ClearFormats
With Selection.Font
.Name = "Gill Sans"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("A1").Select
Cells.EntireColumn.AutoFit
Range("A1").Select

I found this piece of code which successfully removes blank rows from after the data and resets the last cell. Can something like this be added to my macro?:

Sub DelEmptyRows()
Dim i As Long, iLimit As Long
iLimit = ActiveSheet.UsedRange.Rows.Count
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For i = iLimit To 1 Step -1
If Application.CountA(Cells(i, 1).EntireRow) = 0 Then
Cells(i, 1).EntireRow.Delete
End If
Next i
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
iLimit = ActiveSheet.UsedRange.Rows.Count 
ActiveWorkbook.Save
End Sub

Gram


----------



## bomb #21 (Jul 1, 2005)

Hi Gram.

Re: "the easiest thing was to use a selection range that would always be higher than the maximum number of rows (in this case 5000 rows)."

Can you ID a column in which the last used row = number of rows you need to work with?

For example:

x = Range("A65536").End(xlUp).Row
ActiveSheet.Range(Cells(1, 1), Cells(x, 5)).Select

First line figures last used row in column A ; second line selects from A1, down x rows & across 5 columns.


----------



## Zack Barresse (Jul 25, 2004)

Use something like this to find the actual last row/column of a worksheet ...


```
Function LastRow(Optional wks As Worksheet) As Long
    On Error GoTo ErrHandle
    LastRow = wks.Cells.Find("*", after:=wks.Cells(1, 1), searchorder:=xlByRows, searchdirection:=xlPrevious).Row
    Exit Function
ErrHandle:
    LastRow = 0
End Function

Function LastCol(Optional wks As Worksheet) As Long
    On Error GoTo ErrHandle
    LastCol = wks.Cells.Find("*", after:=wks.Cells(1, 1), searchorder:=xlByColumns, searchdirection:=xlPrevious).Column
    Exit Function
ErrHandle:
    LastCol = 0
End Function
```
Call them like so ...


```
Sub test_me()
    MsgBox LastRow(ActiveSheet)
End Sub

Sub test_me2()
    MsgBox LastCol(ActiveSheet)
End Sub
```
You could probably adjust your code to something like this ...


```
Sub PrepareDICO()
    Dim iRow As Long
    ActiveWindow.FreezePanes = False
    If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
    iRow = LastRow(ActiveSheet)
    Cells.Copy
    Cells.PasteSpecial Paste:=xlPasteValues
    Cells.Replace What:="_", Replacement:=" "
    Cells.Replace What:="-", Replacement:=""
    Columns("D").Delete Shift:=xlToLeft
    Range("S4:S" & iRow & ",W4:Z" & iRow & ",AB4:AC" & iRow).Replace What:=" ", Replacement:=""
    Range("D3:AH" & iRow).Cut Destination:=Range("H3:AL" & iRow)
    With Range("D4:G" & iRow)
        .FormulaR1C1 = "=TRIM(RC[4])"
        .Copy
        .PasteSpecial Paste:=xlPasteValues
    End With
    Columns("D:E").Delete Shift:=xlToLeft
    With Range("D4:E" & iRow)
        .FormulaR1C1 = "=RC[2]&RC[4]"
        .Copy
        .PasteSpecial Paste:=xlPasteValues
        .ClearFormats
        .Font.Name = "Gill Sans"
        .Font.Size = 12
    End With
    Range("D3").Value = "French Code"
    Range("E3").Value = "UK Code"
    Range("A3").Copy Range("D3:E3").PasteSpecial(Paste:=xlPasteFormats)
    Cells.EntireColumn.AutoFit
    Range("A1").Select
    Application.CutCopyMode = False
End Sub
```
Note I have not tested this, and if you did, I'd do it on a test workbook first.


----------

