J
jgmiddel
In a worksheet I have an overview, in the row 3 are the headers. The
macro I have looks for the LastCell, but it sometimes happens one (or
more) of the columns is empty. The macro should check the last used
cell in row3 and then . How should I change this macro?
Sub AddNamesAndSort()
Dim PRng As Range
Dim Ccell As Range
Dim LastCell As Range
Dim PreviousPName As String
Set LastCell = Range("B65536").End(xlUp)
Set PRng = Range(Range("B5"), LastCell)
On Error Resume Next
For Each Ccell In PRng
If Ccell <> "" And Ccell <> PreviousPName Then
PreviousPName = Ccell
ActiveWorkbook.Names.Add Name:=Ccell,
RefersTo:=Ccell.CurrentRegion
Dim Rng As Range
Set Rng = Range(Range("calcsheet!B4").Text)
Dim UpDown As Integer
UpDown = Range("calcsheet!B2").Value
ActiveWorkbook.Worksheets("Overview").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Overview").Sort.SortFields.Add
Key:=Rng, _
SortOn:=xlSortOnValues, Order:=UpDown,
DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Overview").Sort
.SetRange Range(Ccell)
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End If
Next
End Sub
macro I have looks for the LastCell, but it sometimes happens one (or
more) of the columns is empty. The macro should check the last used
cell in row3 and then . How should I change this macro?
Sub AddNamesAndSort()
Dim PRng As Range
Dim Ccell As Range
Dim LastCell As Range
Dim PreviousPName As String
Set LastCell = Range("B65536").End(xlUp)
Set PRng = Range(Range("B5"), LastCell)
On Error Resume Next
For Each Ccell In PRng
If Ccell <> "" And Ccell <> PreviousPName Then
PreviousPName = Ccell
ActiveWorkbook.Names.Add Name:=Ccell,
RefersTo:=Ccell.CurrentRegion
Dim Rng As Range
Set Rng = Range(Range("calcsheet!B4").Text)
Dim UpDown As Integer
UpDown = Range("calcsheet!B2").Value
ActiveWorkbook.Worksheets("Overview").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Overview").Sort.SortFields.Add
Key:=Rng, _
SortOn:=xlSortOnValues, Order:=UpDown,
DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Overview").Sort
.SetRange Range(Ccell)
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End If
Next
End Sub