0
votes

I am trying to adapt some code that copies and pastes two separate ranges into another on a different sheet and then sorts it alphabetically. Problem is when i hide the sheet - even though I unhide and re-hide it to run the Macro - it seems to sort only on the Active Column.

I have singled out in bold the sorting code in the second macro below. The GetNamesList macro calls the ConsolidateList towards the end of its code.

The GetNamesList is set to run on workbook open:

Private Sub Workbook_Open()
GetNamesList
End Sub

The original code for GetNamesList is from: http://bit.ly/1y3dU6n by @Siddharth-rout

Sub GetNamesList()
Dim rng As Range, aCell As Range
Dim MyAr() As Variant
Dim n As Long, i As Long

Application.ScreenUpdating = False
Sheet28.Visible = True

'~~> Change this to the relevant sheet
With Sheet3
    '~~> Non Contiguous range
    Set rng = .Range("Table2[Contact 1],Table2[Contact 2]")

    '~~> Get the count of cells in that range
    n = rng.Cells.Count

    '~~> Resize the array to hold the data
    ReDim MyAr(1 To n)

    n = 1

    '~~> Store the values from that range into
    '~~> the array
    For Each aCell In rng.Cells
        MyAr(n) = aCell.Value
        n = n + 1
    Next aCell
End With

'~~> Output the data in Sheet

'~~> Vertically Output to sheet 28
Sheet28.Cells(1, 1).Resize(UBound(MyAr), 1).Value = _
Application.WorksheetFunction.Transpose(MyAr)

ConsolidateList

Sheet28.Visible = False
Application.ScreenUpdating = True
End Sub

ConsolidateList is:

Sub ConsolidateList()
'
' ConsolidateList Macro
' Remove duplicates and blanks
'

  With Sheet28.Range("A1:A1000")
    .Value = .Value
    .RemoveDuplicates Columns:=1, Header:=xlNo
    On Error Resume Next
    .SpecialCells(xlCellTypeBlanks).Delete xlShiftUp
    On Error GoTo 0
End With

Columns("A:A").Sort Key1:=Range("A1"), Order1:=xlAscending

End Sub

Thanks for your help...

**Update - recording of macro to do the same thing...

Sub TestSort()
'
' TestSort Macro
'
Sheets("Jan").Select
Sheets("Sheet1").Visible = True
ActiveWindow.SmallScroll Down:=-405
Range("A1:A134").Select
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("A1"), _
    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
    .SetRange Range("A1:A134")
    .Header = xlGuess
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
ActiveWindow.SmallScroll Down:=-245
Sheets("Sheet1").Select
ActiveWindow.SelectedSheets.Visible = False
End Sub
1
Qualify the range with a specific sheet, e.g. Sheets("Sheet1").Columns("A:A").Sort etc. - SierraOscar
Thanks @S I tried this but it is telling me that "the sort reference is not valid. Make sure that it is within the range, and that the first Sort By box is not the same or blank"?? - Malkier
Have you tried recording the sort action and comparing it to your code? - SierraOscar
@SO - result above... The problem for me here is that it uses ActiveWorksheet and references the exact range A1:A134, which will grow over time... - Malkier
So you can replace ActiveWorksheet with Sheets("Sheet1") or whatever.. And you can set the range to a variable before the sort and use the variable's address property :) - SierraOscar

1 Answers

1
votes

Thanks @S-O. By taking your suggestion and puzzling over the recorded code I was able to cobble together the following:

Sub ConsolidateList()
'
' ConsolidateList Macro
' Remove duplicates and blanks
'

  With Sheet28.Range("A1:A1000")
    .Value = .Value
    .RemoveDuplicates Columns:=1, Header:=xlNo
    On Error Resume Next
    .SpecialCells(xlCellTypeBlanks).Delete xlShiftUp
    On Error GoTo 0
End With

Sheet28.Sort.SortFields.Clear
Sheet28.Sort.SortFields.Add Key:=Range("A1"), _
    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
    .SetRange Range("A1:A134")
    .Header = xlGuess
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

End Sub

Though an ActiveWorkbook seems to have snuck in there...!

**UPDATE

Replaced

With ActiveWorkbook.Worksheets("Sheet1").Sort
    .SetRange Range("A1:A134")

With:

At top

Dim Lastrow As Integer

Then

Lastrow = Sheet28.Cells.Find("*", searchorder:=xlByRows,searchdirection:=xlPrevious).Row
    With Sheet28.Sort
    .SetRange Range("A1:A" & Lastrow)

That fixed it...