My code works most of the times but - excel

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.

Answer 1

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