End if without block if

[ipbr21054]

Morning,

I have the been trying to add a sort code into the existing code but keep getting error messages of which i cant overcome.
Below is the code in use which keeps given me the End if without block if error.

Private Sub Worksheet_Change(ByVal Target As Range)    
    Dim r   As Range
    
    Application.EnableEvents = False
    
        If Target.Address = "$A$6" Then
            With Sheets("INFO").Range("CG2")
                If Len(.Offset(1).Value) Then
                    Set r = .End(xlDown).Offset(1)
                    With .End(xlDown).Offset(1)
                        .Value = UCase$(ActiveSheet.Cells(6, 1).Value)
                        .Interior.ColorIndex = 6
                        .HorizontalAlignment = xlCenter
                        .VerticalAlignment = xlBottom
                        .VerticalAlignment = xlCenter
                        .Borders.LineStyle = xlContinuous
                        .RowHeight = 19.5
                        .Font.Bold = True
                        With ActiveWorkbook.Worksheets("INFO").Sort
                        .SetRange Range("CG2:CG500")
                        .Header = xlYes
                        .MatchCase = False
                        .Orientation = xlTopToBottom
                        .SortMethod = xlPinYin
                        .Apply
                    End With
                End If
             End With
        End If
        
    With Target
        If .Column <> 13 And .Count = 1 And Not .HasFormula Then
            Application.EnableEvents = False
            .Value = UCase$(.Value)
            Application.EnableEvents = True
        End If
    End With
        
    Application.EnableEvents = True
    
End Sub

Have a nice day.

 

[gallen]

It's misleading. It's actually an End With you need

Private Sub Worksheet_Change(ByVal Target As Range)    
    Dim r   As Range
    
    Application.EnableEvents = False
    
        If Target.Address = "$A$6" Then
            With Sheets("INFO").Range("CG2")
                If Len(.Offset(1).Value) Then
                    Set r = .End(xlDown).Offset(1)
                    With .End(xlDown).Offset(1)
                        .Value = UCase$(ActiveSheet.Cells(6, 1).Value)
                        .Interior.ColorIndex = 6
                        .HorizontalAlignment = xlCenter
                        .VerticalAlignment = xlBottom
                        .VerticalAlignment = xlCenter
                        .Borders.LineStyle = xlContinuous
                        .RowHeight = 19.5
                        .Font.Bold = True
                        With ActiveWorkbook.Worksheets("INFO").Sort
                             .SetRange Range("CG2:CG500")
                             .Header = xlYes
                             .MatchCase = False
                             .Orientation = xlTopToBottom
                             .SortMethod = xlPinYin
                             .Apply
                        [B][COLOR=#ff0000]End With[/COLOR][/B]
                    End With
                End If
             End With
        End If
        
    With Target
        If .Column <> 13 And .Count = 1 And Not .HasFormula Then
            Application.EnableEvents = False
            .Value = UCase$(.Value)
            Application.EnableEvents = True
        End If
    End With
        
    Application.EnableEvents = True
    
End Sub

Have a nice day.

 

[ipbr21054]

Many thanks for that,i was scratching my head with that one.

It works & sorts as it should fine,i see the actual sort happening in front of me though as opposed to it just happening without me having to watch it.

Do you have a clue as to why ?

I am on one sheet entering data into a cell where then its copied to the other sheet,the sort that i can see is shown on top of the sheet where i am entering the data.

 

[gallen]

You mauy need to disable screenupdating.

I've added the code here. Note that I've also added error handling which is important especially important when disabling events / screen updating.

Also note my comments. you disable and re-enable events needlessly in the final with section

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim r   As Range
    
    On Error GoTo errHandle 'if we encounter an error, handle it
    
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    
        If Target.Address = "$A$6" Then
            With Sheets("INFO").Range("CG2")
                If Len(.Offset(1).Value) Then
                    Set r = .End(xlDown).Offset(1)
                    With .End(xlDown).Offset(1)
                        .Value = UCase$(ActiveSheet.Cells(6, 1).Value)
                        .Interior.ColorIndex = 6
                        .HorizontalAlignment = xlCenter
                        .VerticalAlignment = xlBottom
                        .VerticalAlignment = xlCenter
                        .Borders.LineStyle = xlContinuous
                        .RowHeight = 19.5
                        .Font.Bold = True
                        With ActiveWorkbook.Worksheets("INFO").Sort
                             .SetRange Range("CG2:CG500")
                             .Header = xlYes
                             .MatchCase = False
                             .Orientation = xlTopToBottom
                             .SortMethod = xlPinYin
                             .Apply
                        End With
                    End With
                End If
             End With
        End If
        
    With Target
        If .Column <> 13 And .Count = 1 And Not .HasFormula Then
            Application.EnableEvents = False [COLOR=#ff0000]'this isn't needed as it is already disabled.[/COLOR]
            .Value = UCase$(.Value)
            Application.EnableEvents = True [COLOR=#ff0000]'this isn't needed as the very next line enables it too.[/COLOR]
        End If
    End With
        
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    
Exit Sub


errHandle:
    'If an error occurs, code below will execute ensuring events and updating are re-enabled
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    MsgBox Err.Description, vbCritical, "Error number: " & Err.Number
    
End Sub

 

[ipbr21054]

Thanks,
Using the supplied last code by you i no longer see it sorting.

Regarding the parts i do not require are you then saying the below code should be in place.

Private Sub Worksheet_Change(ByVal Target As Range)    Dim r   As Range
    
    On Error GoTo errHandle 'if we encounter an error, handle it
    
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    
        If Target.Address = "$A$6" Then
            With Sheets("INFO").Range("CG2")
                If Len(.Offset(1).Value) Then
                    Set r = .End(xlDown).Offset(1)
                    With .End(xlDown).Offset(1)
                        .Value = UCase$(ActiveSheet.Cells(6, 1).Value)
                        .Interior.ColorIndex = 6
                        .HorizontalAlignment = xlCenter
                        .VerticalAlignment = xlBottom
                        .VerticalAlignment = xlCenter
                        .Borders.LineStyle = xlContinuous
                        .RowHeight = 19.5
                        .Font.Bold = True
                        With ActiveWorkbook.Worksheets("INFO").Sort
                             .SetRange Range("CG2:CG500")
                             .Header = xlYes
                             .MatchCase = False
                             .Orientation = xlTopToBottom
                             .SortMethod = xlPinYin
                             .Apply
                        End With
                    End With
                End If
             End With
        End If
        
    With Target
        If .Column <> 13 And .Count = 1 And Not .HasFormula Then

            .Value = UCase$(.Value)
        End If
    End With
        
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    
Exit Sub




errHandle:
    'If an error occurs, code below will execute ensuring events and updating are re-enabled
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    MsgBox Err.Description, vbCritical, "Error number: " & Err.Number
    
End Sub

 

[gallen]

Yes, the 2 lines you have removed were needless any way

 

[ipbr21054]

Thanks very much for your help.