worksheet selects all after VB triggers?

Trevor3007

Trevor3007

Well-known Member
Joined
Jan 26, 2017
Messages
675
Office Version
  1. 365
Platform
  1. Windows
hi,

I use the following code:-

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)   
    If Target.Cells.Count > 1 Or Target.HasFormula Then Exit Sub






    On Error Resume Next


    If Not Intersect(Target, Range("z4:z100")) Is Nothing Then


        Application.EnableEvents = False


        Target = UCase(Target)


        Application.EnableEvents = True


    End If
      


    On Error GoTo 0




If Target.Cells.Count > 1 Or Target.HasFormula Then Exit Sub






    On Error Resume Next


    If Not Intersect(Target, Range("d2:d2000")) Is Nothing Then


        Application.EnableEvents = False


        Target = StrConv(Target, vbProperCase)


        Application.EnableEvents = True


    End If


    On Error GoTo 0
    
    
    
If Target.Cells.Count > 1 Or Target.HasFormula Then Exit Sub






    On Error Resume Next


    If Not Intersect(Target, Range("B2:C1000")) Is Nothing Then


        Application.EnableEvents = False


        Target = StrConv(Target, vbProperCase)


        Application.EnableEvents = True


    End If


    On Error GoTo 0
    
If Target.Cells.Count > 1 Or Target.HasFormula Then Exit Sub








    On Error Resume Next


    If Not Intersect(Target, Range("P2:P1000")) Is Nothing Then


        Application.EnableEvents = False


        Target = StrConv(Target, vbProperCase)


        Application.EnableEvents = True


    End If


    On Error GoTo 0
    
If Target.Cells.Count > 1 Or Target.HasFormula Then Exit Sub






    On Error Resume Next


    If Not Intersect(Target, Range("g2:g1000")) Is Nothing Then


        Application.EnableEvents = False


        Target = StrConv(Target, vbProperCase)


        Application.EnableEvents = True


    End If


    On Error GoTo 0
    
    
 
If Target.Cells.Count > 1 Or Target.HasFormula Then Exit Sub






    On Error Resume Next


    If Not Intersect(Target, Range("m2:m1000")) Is Nothing Then


        Application.EnableEvents = False


        Target = StrConv(Target, vbProperCase)


        Application.EnableEvents = True


    End If


    On Error GoTo 0
         
     
If Target.Cells.Count > 1 Or Target.HasFormula Then Exit Sub






    On Error Resume Next


    If Not Intersect(Target, Range("n2:n1000")) Is Nothing Then


        Application.EnableEvents = False


        Target = StrConv(Target, vbProperCase)


        Application.EnableEvents = True


    End If


    On Error GoTo 0
     
     If Target.Cells.Count > 1 Or Target.HasFormula Then Exit Sub






    On Error Resume Next


    If Not Intersect(Target, Range("d3000:d5000")) Is Nothing Then


        Application.EnableEvents = False


        Target = LCase(Target)


        Application.EnableEvents = True


    End If
      


    On Error GoTo 0
    
    
    On Error Resume Next


    If Not Intersect(Target, Range("i2:i200")) Is Nothing Then


        Application.EnableEvents = False


        Target = LCase(Target)


        Application.EnableEvents = True


    End If
      


    On Error GoTo 0
    
    
    
    
    
    
    
   If Target.Cells.Count > 1 Or Target.HasFormula Then Exit Sub






    On Error Resume Next


    If Not Intersect(Target, Range("x4:x200")) Is Nothing Then


        Application.EnableEvents = False


        Target = UCase(Target)


        Application.EnableEvents = True


    End If
      


    On Error GoTo 0
   
   
   
    If Target.Cells.Count > 1 Or Target.HasFormula Then Exit Sub






    On Error Resume Next


    If Not Intersect(Target, Range("at4:aF200")) Is Nothing Then


        Application.EnableEvents = False


        Target = LCase(Target)


        Application.EnableEvents = True


    End If
      


    On Error GoTo 0
  Application.ScreenUpdating = False
    With Range("A1:S1000")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .font.Name = "Calibri"
        .font.Size = 16
        Range("A2:S1000").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    .Select
    End With
End Sub

although it works OK apart from after the VB runs, it highlights the whole worksheet & moves the cursor to another cell?

I wanted it to run and the cursor to stay in the same spot. location.

Can someone please sort for me?

KR
Trevor3007
 

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)
Sort by date Sort by votes
In the formatting section at the end, remove this line:

Code: 
Range("A2:S1000").Select

and replace all instances of the word Selection with Range("A2:S1000")
 
Upvote 0
hi,

thanks for your assistance, Sorry I don't get it?...just throws back errors when I amend? Can I politely ask that you please amend the code I used in post & then post back to me?

MTIA
Trevor3007
 
Upvote 0
Replace this:

Code: 
    With Range("A1:S1000")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .font.Name = "Calibri"
        .font.Size = 16
        Range("A2:S1000").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    .Select
    End With

with this:

Code: 
    With Range("A1:S1000")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .font.Name = "Calibri"
        .font.Size = 16
    end with
with Range("A2:S1000")
    .Borders(xlDiagonalDown).LineStyle = xlNone
    .Borders(xlDiagonalUp).LineStyle = xlNone
    With .Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With .Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With .Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With .Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With .Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With .Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    End With
 
Upvote 0
YAHOOOO....


great work & thank you!!!
:pray:

Have a great Easter:beerchug:
 
Upvote 0
You must log in or register to reply here.

Similar threads

K
  • Solved
formating question
Replies
3
Views
324
Micron
M
I
  • Question Question
Hide command button on worksheet depending on worksheet cell value
Replies
2
Views
296
ipbr21054
I
I
  • Question Question
Checkbox doesnt show checkmark when it should
Replies
2
Views
180
ipbr21054
I
L
  • Locked
  • Question Question
Help Cleaning Up Code
Replies
2
Views
600
RoryA
RoryA
P
  • Question Question
Issue with button not running in spread sheet only in test mode
Replies
1
Views
379
6StringJazzer
6StringJazzer

Forum statistics

Threads
1,224,823
Messages
6,181,169
Members
453,021
Latest member
Justyna P

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top