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

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop
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

dreid1011
  • Question Question
Recursive Sub Calls and Stack Overflow
2 3
Replies
21
Views
220
6StringJazzer
6StringJazzer
R
  • Question Question
VBA - AUTO FIT, Can we remove make the sum formula in below code
Replies
1
Views
157
Joe4
Joe4
K
  • Question Question
VBA DOUBT- can we add heading color and remove blank columns in this code?
Replies
0
Views
162
Kishore1982
K
K
  • Solved
formating question
Replies
3
Views
312
Micron
M
togenmoser
  • Solved
Help with VBA code error "For variable already in use"
2 3
Replies
22
Views
1K
MARK858
MARK858

Forum statistics

Threads
1,223,911
Messages
6,175,324
Members
452,635
Latest member
laura12345

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