Simplify code possible?

B

Bandito1

Board Regular
Joined
Oct 18, 2018
Messages
233
Office Version
  1. 2016
Platform
  1. Windows
Hi all,

I got this code and I got the feeling it's possible to simplify it.
Got this piece of code alot for a whole set of ranges (column K, M, P, R and on).
It take some time to write so if it's possible to simplify it will help me alot

VBA Code: 
If (Target.Count = 1) Then
        Application.EnableEvents = False
        If (Not Intersect(Target, Me.Range("K:K")) Is Nothing) Then
            If Target = vbNullString Then
                Target.Offset(0, 1) = vbNullString
                Target.Offset(0, 2).Borders(xlEdgeTop).LineStyle = xlNone
                Target.Offset(0, 2).Borders(xlEdgeBottom).LineStyle = xlNone
                Target.Offset(0, 2).Borders(xlEdgeLeft).LineStyle = xlNone
                Target.Offset(0, 2).Borders(xlEdgeLeft).LineStyle = xlContinuous
                Target.Offset(0, 2).Borders(xlEdgeRight).Color = RGB(0, 0, 0)
                Target.Offset(0, 3).Borders(xlEdgeTop).LineStyle = xlNone
                Target.Offset(0, 3).Borders(xlEdgeBottom).LineStyle = xlNone
                Target.Offset(0, 3).Borders(xlEdgeRight).LineStyle = xlNone
            Else
                Target.Offset(0, 1) = Date
                Target.Offset(0, 2).Borders(xlEdgeTop).LineStyle = xlContinuous
                Target.Offset(0, 2).Borders(xlEdgeTop).Color = RGB(255, 0, 0)
                Target.Offset(0, 2).Borders(xlEdgeBottom).LineStyle = xlContinuous
                Target.Offset(0, 2).Borders(xlEdgeBottom).Color = RGB(255, 0, 0)
                Target.Offset(0, 2).Borders(xlEdgeLeft).Color = RGB(255, 0, 0)
                Target.Offset(0, 2).Borders(xlEdgeRight).Color = RGB(255, 0, 0)
                Target.Offset(0, 3).Borders(xlEdgeTop).LineStyle = xlContinuous
                Target.Offset(0, 3).Borders(xlEdgeTop).Color = RGB(255, 0, 0)
                Target.Offset(0, 3).Borders(xlEdgeBottom).LineStyle = xlContinuous
                Target.Offset(0, 3).Borders(xlEdgeBottom).Color = RGB(255, 0, 0)
                Target.Offset(0, 3).Borders(xlEdgeRight).LineStyle = xlContinuous
                Target.Offset(0, 3).Borders(xlEdgeRight).Color = RGB(255, 0, 0)
            End If
        End If
        End If
        Application.EnableEvents = True
 

Excel Facts

Why does 9 mean SUM in SUBTOTAL?
It is because Sum is the 9th alphabetically in Average, Count, CountA, Max, Min, Product, StDev.S, StDev.P, Sum, VAR.S, VAR.P.
Sort by date Sort by votes
Yes it triggers change in column K

I got the same code for the column M, P, R and so on

So exact the same code only
VBA Code: 
If (Not Intersect(Target, Me.Range("K:K")) Is Nothing) Then
will change.

Alot of code and i got the feeling it can be simplified
 
Upvote 0
VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("K:K,M:M,P:P,R:R")) Is Nothing Or Target.Count > 1 Then Exit Sub
<Main code here>
End Sub
 
Upvote 0
That works beatifully, thank you

The target.Offset part, is it possible to make that shorter?
 
Upvote 0
Sorry for double post but can't edit my previous post.
When i put something in Column K the date is displayed in the column next to it.

When i try to do the same with M it doesn't.

It's seperate because of the layout of the table so can't combine it.

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("K:K")) Is Nothing Or Target.Count > 1 Then Exit Sub
If Target = vbNullString Then
                Target.Offset(0, 1) = vbNullString
                Target.Offset(0, 2).Borders(xlEdgeTop).LineStyle = xlNone
                Target.Offset(0, 2).Borders(xlEdgeBottom).LineStyle = xlNone
                Target.Offset(0, 2).Borders(xlEdgeLeft).LineStyle = xlNone
                Target.Offset(0, 2).Borders(xlEdgeLeft).LineStyle = xlContinuous
                Target.Offset(0, 2).Borders(xlEdgeRight).Color = RGB(0, 0, 0)
                Target.Offset(0, 3).Borders(xlEdgeTop).LineStyle = xlNone
                Target.Offset(0, 3).Borders(xlEdgeBottom).LineStyle = xlNone
                Target.Offset(0, 3).Borders(xlEdgeRight).LineStyle = xlNone
            Else
                Target.Offset(0, 1) = Date
                Target.Offset(0, 2).Borders(xlEdgeTop).LineStyle = xlContinuous
                Target.Offset(0, 2).Borders(xlEdgeTop).Color = RGB(255, 0, 0)
                Target.Offset(0, 2).Borders(xlEdgeBottom).LineStyle = xlContinuous
                Target.Offset(0, 2).Borders(xlEdgeBottom).Color = RGB(255, 0, 0)
                Target.Offset(0, 2).Borders(xlEdgeLeft).Color = RGB(255, 0, 0)
                Target.Offset(0, 2).Borders(xlEdgeRight).Color = RGB(255, 0, 0)
                Target.Offset(0, 3).Borders(xlEdgeTop).LineStyle = xlContinuous
                Target.Offset(0, 3).Borders(xlEdgeTop).Color = RGB(255, 0, 0)
                Target.Offset(0, 3).Borders(xlEdgeBottom).LineStyle = xlContinuous
                Target.Offset(0, 3).Borders(xlEdgeBottom).Color = RGB(255, 0, 0)
                Target.Offset(0, 3).Borders(xlEdgeRight).LineStyle = xlContinuous
                Target.Offset(0, 3).Borders(xlEdgeRight).Color = RGB(255, 0, 0)
            End If
        Application.EnableEvents = True
If Intersect(Target, Range("M:M")) Is Nothing Or Target.Count > 1 Then Exit Sub
If Target = vbNullString Then
                Target.Offset(0, 1) = vbNullString
            Else
                Target.Offset(0, 1) = Date
            End If
End Sub
 
Upvote 0
Use only one "If..." to exit sub at beggining
VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("K:K,M:M,P:P,R:R")) Is Nothing Or Target.Count > 1 Then Exit Sub
Application.EnableEvents = False
If Target = vbNullString Then
                Target.Offset(0, 1) = vbNullString
                Target.Offset(0, 2).Borders(xlEdgeTop).LineStyle = xlNone
                Target.Offset(0, 2).Borders(xlEdgeBottom).LineStyle = xlNone
                Target.Offset(0, 2).Borders(xlEdgeLeft).LineStyle = xlNone
                Target.Offset(0, 2).Borders(xlEdgeLeft).LineStyle = xlContinuous
                Target.Offset(0, 2).Borders(xlEdgeRight).Color = RGB(0, 0, 0)
                Target.Offset(0, 3).Borders(xlEdgeTop).LineStyle = xlNone
                Target.Offset(0, 3).Borders(xlEdgeBottom).LineStyle = xlNone
                Target.Offset(0, 3).Borders(xlEdgeRight).LineStyle = xlNone
Else
                Target.Offset(0, 1) = Date
                Target.Offset(0, 2).Borders(xlEdgeTop).LineStyle = xlContinuous
                Target.Offset(0, 2).Borders(xlEdgeTop).Color = RGB(255, 0, 0)
                Target.Offset(0, 2).Borders(xlEdgeBottom).LineStyle = xlContinuous
                Target.Offset(0, 2).Borders(xlEdgeBottom).Color = RGB(255, 0, 0)
                Target.Offset(0, 2).Borders(xlEdgeLeft).Color = RGB(255, 0, 0)
                Target.Offset(0, 2).Borders(xlEdgeRight).Color = RGB(255, 0, 0)
                Target.Offset(0, 3).Borders(xlEdgeTop).LineStyle = xlContinuous
                Target.Offset(0, 3).Borders(xlEdgeTop).Color = RGB(255, 0, 0)
                Target.Offset(0, 3).Borders(xlEdgeBottom).LineStyle = xlContinuous
                Target.Offset(0, 3).Borders(xlEdgeBottom).Color = RGB(255, 0, 0)
                Target.Offset(0, 3).Borders(xlEdgeRight).LineStyle = xlContinuous
                Target.Offset(0, 3).Borders(xlEdgeRight).Color = RGB(255, 0, 0)
End If
Application.EnableEvents = True
End Sub
 
Upvote 0
Sorry i was not clear.

The code for the columns K,P,U is the same.
For M, R, W it should be different.

How do i make that?
That's why i made second If..
 
Upvote 0
So you want to trigger different columns with different code?
VBA Code: 
If  Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("K:K")) Is Nothing Then
     <code for column K here>
ElseIf Not Intersect(Target, Range("M:M")) Is Nothing Then
      <code for column M here>
ElseIf  ....> for other column>

....
End if

Use "Range("K:K,P:P,U:U")" for multiple columns with same code
 
Upvote 0
Solution
You must log in or register to reply here.

Similar threads

K
  • Solved
formating question
Replies
3
Views
82
Micron
M
togenmoser
  • Solved
Help with VBA code error "For variable already in use"
2 3
Replies
22
Views
350
MARK858
MARK858
L
  • Locked
  • Question
Help Cleaning Up Code
Replies
2
Views
341
RoryA
RoryA
J
  • Question
Transferring VBA code to another cell
2 3
Replies
20
Views
586
Joek88
J
B
  • Solved
Hard set column instead of using offset
Replies
5
Views
326
Bandito1
B

Forum statistics

Threads
1,215,129
Messages
6,123,214
Members
449,091
Latest member
jeremy_bp001

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