My code works most of the times but

Question

I created this program for a spreadsheet in my work.

My code works almost all the time, but some times it decides to bug without any reason. (It doesn't show any error message, it just don't do what it was supposed to do. It when it sorts, sometimes it copies other row's information, but it should be all blank)

My program is basically sorting automatically two stacked tables in the same sheet.

CODE:

Option Explicit

Sub Sorting()

' Keyboard Shortcut: Ctrl+m
'
'******************************* Define variables for the data that I want to store for later use
Dim MyDataFirstCell
Dim MyDataLastCell
Dim MySortCellStart
Dim MySortCellEnd

Dim MyDataFirstCell2
Dim MyDataLastCell2
Dim MySortCellStart2
Dim MySortCellEnd2

'************************** Establish the Data Area
  ActiveSheet.Range("B1").Select
  'Next Non Blank Cell down
  ActiveCell.Offset(1, 0).Select
  Do While IsEmpty(ActiveCell)
    DoEvents
    ActiveCell.Offset(1, 0).Select
  Loop

  ActiveCell.Offset(1, 0).Select

  DoEvents
  MyDataFirstCell = ActiveCell.Address 'Get the first cell address of Data Area

  Selection.End(xlDown).Select 'Get to Bottom Row of the data
  Selection.End(xlToRight).Select 'Get to the last Column and data cell by heading to the righthand end
  Selection.End(xlToRight).Select
  ActiveCell.Offset(-1, 0).Select ' Select the correct last cell
  MyDataLastCell = ActiveCell.Address 'Get the Cell address of the last cell of my data area

'************************** Establish the Sort column first and last data points.
  ActiveSheet.Range("B1").Select
  'Next Non Blank Cell down
  ActiveCell.Offset(1, 0).Select
  Do While IsEmpty(ActiveCell)
    DoEvents
    ActiveCell.Offset(1, 0).Select
  Loop

  ActiveCell.Offset(1, 0).Select 'Get to first cell of data sort Column (Example Col 'R' Row 2 becuase Row 1 contains the header)
  DoEvents
  MySortCellStart = ActiveCell.Address 'Get the Cell address of the first cell of my data sort Column
  Selection.End(xlDown).Select 'Get to the bottom Row of data
  ActiveCell.Offset(-1, 0).Select
  MySortCellEnd = ActiveCell.Address 'Get the Cell address of the last cell of my sort Column

'************************** Start the sort by specifying sort area and columns
  ActiveSheet.Sort.SortFields.Clear
  ActiveSheet.Sort.SortFields.Add _
    Key:=Range(MySortCellStart & ":" & MySortCellEnd), SortOn:=xlSortOnValues, Order:=xlAscending, _
    DataOption:=xlSortNormal
  With ActiveSheet.Sort
    .SetRange Range(MyDataFirstCell & ":" & MyDataLastCell)
    .Header = xlNo
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
  End With

  'Second sorting
  '************************** Establish the Data Area
  ActiveSheet.Range("B1").Select
  'Next Non Blank Cell down
  ActiveCell.Offset(1, 0).Select
  Do While IsEmpty(ActiveCell)
    DoEvents
    ActiveCell.Offset(1, 0).Select
  Loop

  'Next Blank Cell down
  ActiveCell.Offset(1, 0).Select
  Do While Not IsEmpty(ActiveCell)
    DoEvents
    ActiveCell.Offset(1, 0).Select
  Loop

  'Next Non Blank Cell down
  ActiveCell.Offset(1, 0).Select
  Do While IsEmpty(ActiveCell)
    DoEvents
    ActiveCell.Offset(1, 0).Select
  Loop

  DoEvents
  ActiveCell.Offset(1, 0).Select

  MyDataFirstCell2 = ActiveCell.Address 'Get the first cell address of Data Area

  Selection.End(xlDown).Select 'Get to Bottom Row of the data
  Selection.End(xlToRight).Select 'Get to the last Column and data cell by heading to the righthand end
  Selection.End(xlToRight).Select
  ActiveCell.Offset(-1, 0).Select ' Select the correct last cell
  MyDataLastCell2 = ActiveCell.Address 'Get the Cell address of the last cell of my data area

'************************** Establish the Sort column first and last data points.
  ActiveSheet.Range("B1").Select
  'Next Non Blank Cell down
  ActiveCell.Offset(1, 0).Select
  Do While IsEmpty(ActiveCell)
    ActiveCell.Offset(1, 0).Select
  Loop

'Next Blank Cell down
  ActiveCell.Offset(1, 0).Select
  Do While Not IsEmpty(ActiveCell)
    ActiveCell.Offset(1, 0).Select
  Loop

'Next Non Blank Cell down
  ActiveCell.Offset(1, 0).Select
  Do While IsEmpty(ActiveCell)
    ActiveCell.Offset(1, 0).Select
  Loop


  ActiveCell.Offset(1, 0).Select 'Get to first cell of data sort Column (Example Col 'R' Row 2 becuase Row 1 contains the header)
  MySortCellStart2 = ActiveCell.Address 'Get the Cell address of the first cell of my data sort Column
  Selection.End(xlDown).Select 'Get to the bottom Row of data
  ActiveCell.Offset(-1, 0).Select
  MySortCellEnd2 = ActiveCell.Address 'Get the Cell address of the last cell of my sort Column

'************************** Start the sort by specifying sort area and columns
  ActiveSheet.Sort.SortFields.Clear
  ActiveSheet.Sort.SortFields.Add _
    Key:=Range(MySortCellStart2 & ":" & MySortCellEnd2), SortOn:=xlSortOnValues, Order:=xlAscending, _
    DataOption:=xlSortNormal
  With ActiveSheet.Sort
    .SetRange Range(MyDataFirstCell2 & ":" & MyDataLastCell2)
    .Header = xlNo
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
  End With

'Select first element of first table
  DoEvents
  ActiveSheet.Range("F1").Select
  Range(MyDataFirstCell).Select

End Sub

I am new at coding with VBA, I know languages like C and for LPC, but I have never learned VBA. So, any help of how to solve the problem or to improve my code, I'm all about it.

Thank you very much for your patience, attention and help.

You can shorten your code a ton by [avoiding the use of `.Select`](http://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros). I haven't really looked through your code, but using `.Select` can cause unexpected results. When it does error out, click "Debug" - what line does the error occur on, and what error is it? — BruceWayne, Sep 28 '16 at 14:28
@BruceWayne That is the problem, it doesn't show me any error, it just don't do what it is supposed to do sometimes — Lucas Poloni Cordeiro, Sep 28 '16 at 14:29
@BruceWayne How can I use sorting system without using .Select? How can I decide where I want to have my cell selection without using it? — Lucas Poloni Cordeiro, Sep 28 '16 at 14:32
I linked to an SO thread in my comment, or click [here](http://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros). — BruceWayne, Sep 28 '16 at 14:34
I doubt that it "decides to bug without any reason". More likely, it has a reason but you don't know what the reason is. — John Coleman, Sep 28 '16 at 14:45

score 0 · Answer 1 · answered Sep 28 '16 at 15:08

You're code is really hard to follow - there's a good chance the wrong cell is selected at some point and you're subsequently trying to perform an illegal operation on the cell.

The code below will sort all the regions in your workbook by the second column (and will probably fail if any regions don't have a second column).

The important bit (other than the important bit I've highlighted in the code) is
Set rCurrentRegion = - this needs to be a reference to the range you're sorting.
It can be set manually using something like
Set rCurrentRegion = ThisWorkbook.Worksheets("Sheet1").Range("A10:Z5000").
In your code it would be
Set rCurrentRegion = Range(MySortCellStart2 & ":" & MySortCellEnd2) (although you're missing the worksheet reference - it will act on the activesheet otherwise).

Sub Test()

    Dim Regions As Variant
    Dim x As Long
    Dim rCurrentRegion As Range

    'Get a list of all the regions in your workbook as the range
    'in your code doesn't appear to be in a static location.
    'This will return an array of cell addresses.
    'e.g. Regions(0) = "Sheet1!A4:P16"
    '     Regions(1) = "Sheet1!A21:L33"
    Regions = FindRegionsInWorkbook(ThisWorkbook)

    'Work through each element in the Regions array.
    For x = LBound(Regions) To UBound(Regions)

        'Turn the array element into a Range object.
        Set rCurrentRegion = Range(Regions(x))

        '''''''''''''''''''''''''''''''''''''''''''''''''''''''
        'THIS IS THE IMPORTANT BIT                            '
        'Sorting without selecting - the range that was       '
        'identified in the previous line of code is acted on. '
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''

        'The Parent of the range is the worksheet object.
        With rCurrentRegion.Parent
            .Sort.SortFields.Clear
            'We're going to sort by the second column in the range.
            .Sort.SortFields.Add _
                Key:=rCurrentRegion.Columns(2), _
                SortOn:=xlSortOnValues, _
                Order:=xlAscending, _
                DataOption:=xlSortNormal
            'Apply the sort.
            With .Sort
                .SetRange rCurrentRegion
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
        End With

    Next x

End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'This function returns all the separate regions in your workbook. '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function FindRegionsInWorkbook(wrkBk As Workbook) As Variant
    Dim ws As Worksheet, rRegion As Range, sRegion As String, sCheck As String
    Dim sAddys As String, arrAddys() As String, aRegions() As Variant
    Dim iCnt As Long, i As Long, j As Long
    '//Cycle through each worksheet in workbook.
    j = 0
    For Each ws In wrkBk.Worksheets
        sAddys = vbNullString
        sRegion = vbNullString
        On Error Resume Next
        '//Find all ranges of constant & formula valies in worksheet.
        sAddys = ws.Cells.SpecialCells(xlCellTypeConstants, 23).Address(0, 0) & ","
        sAddys = sAddys & ws.Cells.SpecialCells(xlCellTypeFormulas, 23).Address(0, 0)
        If Right(sAddys, 1) = "," Then sAddys = Left(sAddys, Len(sAddys) - 1)
        On Error GoTo 0
        If sAddys = vbNullString Then GoTo SkipWs
        '//Put each seperate range into an array.
        If InStr(1, sAddys, ",") = 0 Then
            ReDim arrAddys(0 To 0)
            arrAddys(0) = "'" & ws.Name & "'!" & sAddys
        Else
            arrAddys = Split(sAddys, ",")
            For i = LBound(arrAddys) To UBound(arrAddys)
                arrAddys(i) = "'" & ws.Name & "'!" & arrAddys(i)
            Next i
        End If
        '//Place region that range sits in into sRegion (if not already in there).
        For i = LBound(arrAddys) To UBound(arrAddys)
            If InStr(1, sRegion, ws.Range(arrAddys(i)).CurrentRegion.Address(0, 0)) = 0 Then
                sRegion = sRegion & ws.Range(arrAddys(i)).CurrentRegion.Address(0, 0) & "," '*** no sheet
                sCheck = Right(arrAddys(i), Len(arrAddys(i)) - InStr(1, arrAddys(i), "!"))
                ReDim Preserve aRegions(0 To j)
                aRegions(j) = Left(arrAddys(i), InStr(1, arrAddys(i), "!") - 1) & "!" & ws.Range(sCheck).CurrentRegion.Address(0, 0)
                j = j + 1
            End If
        Next i
SkipWs:
    Next ws
    On Error GoTo ErrHandle
    FindRegionsInWorkbook = aRegions
    Exit Function
ErrHandle:
    'things you might want done if no lists were found...
End Function

My code works most of the times but

1 Answers1