Simplify code possible?

B

Bandito1

Board Regular
Joined
Oct 18, 2018
Messages
239
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

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.
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

R
  • Question Question
VBA - AUTO FIT, Can we remove make the sum formula in below code
Replies
1
Views
151
Joe4
Joe4
K
  • Question Question
VBA DOUBT- can we add heading color and remove blank columns in this code?
Replies
0
Views
156
Kishore1982
K
K
  • Solved
formating question
Replies
3
Views
299
Micron
M
togenmoser
  • Solved
Help with VBA code error "For variable already in use"
2 3
Replies
22
Views
1K
MARK858
MARK858
L
  • Locked
  • Question Question
Help Cleaning Up Code
Replies
2
Views
576
RoryA
RoryA

Forum statistics

Threads
1,223,227
Messages
6,170,848
Members
452,361
Latest member
d3ad3y3

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