worksheet selects all after VB triggers?

Trevor3007

Trevor3007

Well-known Member
Joined
Jan 26, 2017
Messages
667
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

What does custom number format of ;;; mean?
Three semi-colons will hide the value in the cell. Although most people use white font instead.
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(y)
 
Upvote 0
You must log in or register to reply here.

Similar threads

K
  • Solved
formating question
Replies
3
Views
95
Micron
M
L
  • Locked
  • Question
Help Cleaning Up Code
Replies
2
Views
354
RoryA
RoryA
P
  • Question
Issue with button not running in spread sheet only in test mode
Replies
1
Views
206
6StringJazzer
6StringJazzer
S
  • Question
Need code that adds multiple new rows to table to include a check box in column "L" for each new row
Replies
0
Views
353
sspatriots
S
K
  • Solved
create a button that do actions
2 3
Replies
22
Views
885
kerm007
K

Forum statistics

Threads
1,215,455
Messages
6,124,935
Members
449,195
Latest member
Stevenciu

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