PDA

View Full Version : VBA second half repeats twice



Juriemagic
07-28-2015, 11:49 PM
Hi good people!..

I have a code which I put together from recording macros, when I run the code the second half repeats. I have noticed that the sorting of the values also only sorts in the second round. The code is:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Range("AN2") = 0 Then
Exit Sub
End If
If Range("AN2") = 1 And Range("AN27") = 0 Then
MsgBox "No Records Found"
Range("AN2").FormulaR1C1 = 0
End If
If Range("AN2") = 1 And Range("AN27") = 1 Then
application.ScreenUpdating = False
Range("AO28:AO5028").Value = Range("AN28:AN5028").Value
Range("T28:AO5028").Select
ActiveWorkbook.Worksheets("COMPLETED WORK ORDERS").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("COMPLETED WORK ORDERS").Sort.SortFields.Add Key:= _
Range("AO28:AO5028"), SortOn:=xlSortOnValues, Order:=xlDescending, _
DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("COMPLETED WORK ORDERS").Sort.SortFields.Add Key:= _
Range("T28:T5028"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
With ActiveWorkbook.Worksheets("COMPLETED WORK ORDERS").Sort
.SetRange Range("T28:AO5028")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
MsgBox "All Data Retrieved"
Range("AN2").FormulaR1C1 = 0
Range("E8").Select
End If
End Sub


Please help me to make the proper modification. All help will be greatly appreciated!

Aflatoon
07-29-2015, 12:44 AM
You're selecting cells in a SelectionChange event. If you need to do that (and I can't see any need here) you must disable events first so that the event doesn't trigger itself recursively.

Aussiebear
07-29-2015, 01:01 AM
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Range("AN2").Value = 0 Then
Exit Sub
Elseif Range("AN2").value = 1 and Range("AN27").value = 0 Then
Msgbox "No Records Found"
ElseIF Range("AN2").value = 1 and Range("AN27").value = 1 Then
Application.ScreenUpdating = False
Application.EnableEvents= False
Range("AO28:AO5028".Value = Range("AN28":AN5028").value
With ActiveWorkbook.Worksheets("COMPLETED WORK ORDERS").Sort
.SetRange Range("T28:AO5028")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Application.ScreenUpdating = True
Application.EnableEvents = true
MsgBox "All Data Retrieved"
Range("AN2").Value = 0
Range("E8").Activate
End With
End if
End Sub

Aflatoon
07-29-2015, 02:26 AM
Assuming this code is in the COMPLETED WORK ORDERS sheet:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

On Error GoTo catch
If Range("AN2") = 0 Then Exit Sub


If Range("AN2") = 1 Then
If Range("AN27") = 0 Then
MsgBox "No Records Found"
Range("AN2").Value2 = 0
ElseIf Range("AN27") = 1 Then
With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Range("AO28:AO5028").Value = Range("AN28:AN5028").Value
With Me.Sort
With .SortFields
.Clear
.Add Key:=Me.Range("AO28:AO5028"), SortOn:=xlSortOnValues, _
Order:=xlDescending, DataOption:=xlSortNormal
.Add Key:=Me.Range("T28:T5028"), SortOn:=xlSortOnValues, _
Order:=xlAscending, DataOption:=xlSortNormal
End With
.SetRange Me.Range("T28:AO5028")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
MsgBox "All Data Retrieved"
Range("AN2").Value2 = 0

With Application
.EnableEvents = True
.ScreenUpdating = True
End With

End If

End If

finally:
Application.EnableEvents = True
Exit Sub

catch:
MsgBox Err.Description
Resume finally
End Sub