Hard set column instead of using offset

B

Bandito1

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

I use the code below to color the border of the cell next to K if something is put in column K.
I use Offset for this.

Now i would like to expand this code to other columns but "hard set" that the borders of column C are colored.
So offset doesn't work since the Offset from K to C = -8 but when i want this code from L it isn't -8 but -9.
How do i say column "C" instead of using Target.Offset?

VBA Code: 
If Target.Count > 1 Then Exit Sub
        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 = xlContinuous
                Target.Offset(0, 3).Borders(xlEdgeRight).Color = RGB(0, 0, 0)
            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
    ElseIf Not Intersect(Target, Range("M:M")) Is Nothing Then
           If Target = vbNullString Then
                Target.Offset(0, 1) = vbNullString
                Target.Offset(0, 0).Borders(xlEdgeTop).LineStyle = xlContinuous
                Target.Offset(0, 0).Borders(xlEdgeBottom).LineStyle = xlContinuous
                Target.Offset(0, 0).Borders(xlEdgeRight).LineStyle = xlContinuous
                Target.Offset(0, 0).Borders(xlEdgeTop).Color = RGB(255, 0, 0)
                Target.Offset(0, 0).Borders(xlEdgeBottom).Color = RGB(255, 0, 0)
                Target.Offset(0, 0).Borders(xlEdgeRight).Color = RGB(255, 0, 0)
                Target.Offset(0, 0).Borders(xlEdgeLeft).Color = RGB(255, 0, 0)
                Target.Offset(0, 1).Borders(xlEdgeTop).LineStyle = xlContinuous
                Target.Offset(0, 1).Borders(xlEdgeBottom).LineStyle = xlContinuous
                Target.Offset(0, 1).Borders(xlEdgeRight).LineStyle = xlContinuous
                Target.Offset(0, 1).Borders(xlEdgeTop).Color = RGB(255, 0, 0)
                Target.Offset(0, 1).Borders(xlEdgeBottom).Color = RGB(255, 0, 0)
                Target.Offset(0, 1).Borders(xlEdgeRight).Color = RGB(255, 0, 0)
            Else
                 Target.Offset(0, 1) = Date
                 Target.Offset(0, 0).Borders(xlEdgeTop).LineStyle = xlNone
                 Target.Offset(0, 0).Borders(xlEdgeBottom).LineStyle = xlNone
                 Target.Offset(0, 0).Borders(xlEdgeRight).Color = RGB(0, 0, 0)
                 Target.Offset(0, 0).Borders(xlEdgeLeft).Color = RGB(0, 0, 0)
                 Target.Offset(0, 1).Borders(xlEdgeTop).LineStyle = xlNone
                 Target.Offset(0, 1).Borders(xlEdgeBottom).LineStyle = xlNone
                 Target.Offset(0, 1).Borders(xlEdgeRight).LineStyle = xlNone
                 Target.Offset(0, 1).Borders(xlEdgeRight).LineStyle = xlContinuous
                 
            End If
        End If
 

Excel Facts

Repeat Last Command
Pressing F4 adds dollar signs when editing a formula. When not editing, F4 repeats last command.
Sort by date Sort by votes
There's gotta be a better way, but this is what I could think of:
VBA Code: 
        If Not Intersect(Target, Me.Range("K:K")) Is Nothing Then
                Dim RowAddress As String
                Dim StartRow As Integer
                Dim EndRow As Integer
               
                RowAddress = Target.EntireRow.Address
               
                StartRow = Left(Mid(RowAddress, 2, 100), InStr(Mid(RowAddress, 2, 100), ":") - 1)
                EndRow = Application.Substitute(RowAddress, "$" & StartRow & ":$", "")
           
                Range(Cells(StartRow, 3), Cells(EndRow, 3)).Borders(xlEdgeTop).LineStyle = xlNone
                Range(Cells(StartRow, 3), Cells(EndRow, 3)).Borders(xlEdgeBottom).LineStyle = xlNone
                Range(Cells(StartRow, 3), Cells(EndRow, 3)).Borders(xlEdgeLeft).LineStyle = xlNone
                Range(Cells(StartRow, 3), Cells(EndRow, 3)).Borders(xlEdgeLeft).LineStyle = xlContinuous
                Range(Cells(StartRow, 3), Cells(EndRow, 3)).Borders(xlEdgeRight).Color = RGB(0, 0, 0)
        End If
 
Upvote 0
On second thought, this might work for you, using "3-Target.Column" in the row argument of the offset function:
VBA Code: 
        If Not Intersect(Target, Me.Range("K:K")) Is Nothing Then
                        
            Dim OffsetClm As Integer
            OffsetClm = Target.Column - 3
            
                
                Target.Offset(0, 3 - Target.Column).Borders(xlEdgeTop).LineStyle = xlNone
                Target.Offset(0, 3 - Target.Column).Borders(xlEdgeBottom).LineStyle = xlNone
                Target.Offset(0, 3 - Target.Column).Borders(xlEdgeLeft).LineStyle = xlNone
                Target.Offset(0, 3 - Target.Column).Borders(xlEdgeLeft).LineStyle = xlContinuous
                Target.Offset(0, 3 - Target.Column).Borders(xlEdgeRight).Color = RGB(0, 0, 0)
                Target.Offset(0, 3 - Target.Column).Borders(xlEdgeTop).LineStyle = xlNone
                Target.Offset(0, 3 - Target.Column).Borders(xlEdgeBottom).LineStyle = xlNone
                Target.Offset(0, 3 - Target.Column).Borders(xlEdgeRight).LineStyle = xlContinuous
                Target.Offset(0, 3 - Target.Column).Borders(xlEdgeRight).Color = RGB(0, 0, 0)
        End If
 
Upvote 0
Hi, thanks for your reply.
I don't think i was clear enough, sorry for that.

When an x is placed in column K the borders column M and N turn red.
This is done with offset.

This is also done for columns P:P,U:U,Z:Z,AD:AD

Now i would like that the borders in column C turn red if and x is placed in K,P,U,Z,AD.
This can't be done with offset since from column K to C is 8 but from P to C is 12.



This is my full code;

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Dim xRg As Range, xCell As Range
    Dim Uppercase, Lowercase
    On Error Resume Next
    If (Target.Count = 1) Then
        Application.EnableEvents = False
        If (Not Intersect(Target, Me.Range("A:A")) Is Nothing) Then
            If Target = vbNullString Then
                Target.Offset(0, 8) = vbNullString
            Else
                Target.Offset(0, 8) = Date
            End If
        End If
        End If
        Application.EnableEvents = True
    If (Target.Count = 1) Then
        Application.EnableEvents = False
        If (Not Intersect(Target, Me.Range("C:C")) Is Nothing) Then
            If Target = vbNullString Then
                Target.Offset(0, 7) = vbNullString
            Else
                Target.Offset(0, 7) = Date
            End If
        End If
        End If
        Application.EnableEvents = True
    If (Target.Count = 1) Then
        Application.EnableEvents = False
        If (Not Intersect(Target, Me.Range("F:F")) Is Nothing) Then
            If Target = vbNullString Then
                Target.Offset(0, 1) = vbNullString
            Else
                Target.Offset(0, 1) = Date
            End If
        End If
        End If
        Application.EnableEvents = True
     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
            Else
                Target.Offset(0, 1) = Date
            End If
        End If
        End If
        Application.EnableEvents = True
    If (Target.Count = 1) Then
        Application.EnableEvents = False
        If (Not Intersect(Target, Me.Range("M:M")) Is Nothing) Then
            If Target = vbNullString Then
                Target.Offset(0, 1) = vbNullString
            Else
                Target.Offset(0, 1) = Date
            End If
        End If
        End If
        Application.EnableEvents = True
    If (Target.Count = 1) Then
        Application.EnableEvents = False
        If (Not Intersect(Target, Me.Range("P:P")) Is Nothing) Then
            If Target = vbNullString Then
                Target.Offset(0, 1) = vbNullString
            Else
                Target.Offset(0, 1) = Date
            End If
        End If
        End If
        Application.EnableEvents = True
    If (Target.Count = 1) Then
        Application.EnableEvents = False
        If (Not Intersect(Target, Me.Range("R:R")) Is Nothing) Then
            If Target = vbNullString Then
                Target.Offset(0, 1) = vbNullString
            Else
                Target.Offset(0, 1) = Date
            End If
        End If
        End If
        Application.EnableEvents = True
    If (Target.Count = 1) Then
        Application.EnableEvents = False
        If (Not Intersect(Target, Me.Range("U:U")) Is Nothing) Then
            If Target = vbNullString Then
                Target.Offset(0, 1) = vbNullString
            Else
                Target.Offset(0, 1) = Date
            End If
        End If
        End If
        Application.EnableEvents = True
    If (Target.Count = 1) Then
        Application.EnableEvents = False
        If (Not Intersect(Target, Me.Range("W:W")) Is Nothing) Then
            If Target = vbNullString Then
                Target.Offset(0, 1) = vbNullString
            Else
                Target.Offset(0, 1) = Date
            End If
        End If
        End If
        Application.EnableEvents = True
    If (Target.Count = 1) Then
        Application.EnableEvents = False
        If (Not Intersect(Target, Me.Range("Z:Z")) Is Nothing) Then
            If Target = vbNullString Then
                Target.Offset(0, 1) = vbNullString
            Else
                Target.Offset(0, 1) = Date
            End If
            End If
        Application.EnableEvents = True
        If (Target.Count = 1) Then
        Application.EnableEvents = False
    If (Not Intersect(Target, Me.Range("AB:AB")) Is Nothing) Then
            If Target = vbNullString Then
                Target.Offset(0, 1) = vbNullString
            Else
                Target.Offset(0, 1) = Date
            End If
        End If
        End If
        Application.EnableEvents = True
    If (Target.Count = 1) Then
        Application.EnableEvents = False
        If (Not Intersect(Target, Me.Range("AD:AD")) Is Nothing) Then
            If Target = vbNullString Then
                Target.Offset(0, 1) = vbNullString
            Else
                Target.Offset(0, 1) = Date
            End If
            End If
        Application.EnableEvents = True
        End If
        End If
    If (Target.Count = 1) Then
        Application.EnableEvents = False
        If (Not Intersect(Target, Me.Range("AF:AF")) Is Nothing) Then
            If Target = vbNullString Then
                Target.Offset(0, 1) = vbNullString
            Else
                Target.Offset(0, 1) = Date
            End If
            End If
        Application.EnableEvents = True
        End If

     If Target.Count > 1 Then Exit Sub
        If Not Intersect(Target, Me.Range("K:K,P:P,U:U,Z:Z,AD:AD")) 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 = xlContinuous
                Target.Offset(0, 3).Borders(xlEdgeRight).Color = RGB(0, 0, 0)
                Range("C" & i).BorderAround ColorIndex:=3
            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)
                Range("C" & i).BorderAround ColorIndex:=3
            End If
    ElseIf Not Intersect(Target, Range("M:M,R:R,W:W,AB:AB,AF:AF")) Is Nothing Then
           If Target = vbNullString Then
                Target.Offset(0, 1) = vbNullString
                Target.Offset(0, 0).Borders(xlEdgeTop).LineStyle = xlContinuous
                Target.Offset(0, 0).Borders(xlEdgeBottom).LineStyle = xlContinuous
                Target.Offset(0, 0).Borders(xlEdgeRight).LineStyle = xlContinuous
                Target.Offset(0, 0).Borders(xlEdgeTop).Color = RGB(255, 0, 0)
                Target.Offset(0, 0).Borders(xlEdgeBottom).Color = RGB(255, 0, 0)
                Target.Offset(0, 0).Borders(xlEdgeRight).Color = RGB(255, 0, 0)
                Target.Offset(0, 0).Borders(xlEdgeLeft).Color = RGB(255, 0, 0)
                Target.Offset(0, 1).Borders(xlEdgeTop).LineStyle = xlContinuous
                Target.Offset(0, 1).Borders(xlEdgeBottom).LineStyle = xlContinuous
                Target.Offset(0, 1).Borders(xlEdgeRight).LineStyle = xlContinuous
                Target.Offset(0, 1).Borders(xlEdgeTop).Color = RGB(255, 0, 0)
                Target.Offset(0, 1).Borders(xlEdgeBottom).Color = RGB(255, 0, 0)
                Target.Offset(0, 1).Borders(xlEdgeRight).Color = RGB(255, 0, 0)
            Else
                 Target.Offset(0, 1) = Date
                 Target.Offset(0, 0).Borders(xlEdgeTop).LineStyle = xlNone
                 Target.Offset(0, 0).Borders(xlEdgeBottom).LineStyle = xlNone
                 Target.Offset(0, 0).Borders(xlEdgeRight).Color = RGB(0, 0, 0)
                 Target.Offset(0, 0).Borders(xlEdgeLeft).Color = RGB(0, 0, 0)
                 Target.Offset(0, 1).Borders(xlEdgeTop).LineStyle = xlNone
                 Target.Offset(0, 1).Borders(xlEdgeBottom).LineStyle = xlNone
                 Target.Offset(0, 1).Borders(xlEdgeRight).LineStyle = xlNone
                 Target.Offset(0, 1).Borders(xlEdgeRight).LineStyle = xlContinuous
                 
            End If
        End If

Test.xlsm
ABCDEFGHIJKLMNOPQRS
3513GreenGrass30-sep-22x17-sep-22
Sheet1
Cells with Conditional Formatting
CellConditionCell FormatStop If True
A3:A1048573Expression=$F3<>""textNO
A3:AG1048573Expression=AND($A3<>"";MOD(SUBTOTAL(3;$A$3:$A3);2)=0)textNO
 
Upvote 0
Let's say you want to use offset. If you are trying to accomplish this, but do not want to hardcode the 8 and 12 respectively:
When target is in K = Target.Offset(0, 8)
When target is in P = Target.Offset(0, 12)

You can change your offset formula to this:
Target.Offset(0, 3-Target.Column)

This will always set the offset location to column C, regardless which column your target is pointing too. Hopefully this makes sense :)
 
Upvote 0
Solution
You must log in or register to reply here.

Similar threads

K
  • Solved
formating question
Replies
3
Views
105
Micron
M
togenmoser
  • Solved
Help with VBA code error "For variable already in use"
2 3
Replies
22
Views
445
MARK858
MARK858
L
  • Locked
  • Question
Help Cleaning Up Code
Replies
2
Views
365
RoryA
RoryA
B
  • Solved
Simplify code possible?
Replies
9
Views
345
Bandito1
B
P
  • Question
Rationalise Code
Replies
1
Views
183
mumps
mumps

Forum statistics

Threads
1,215,882
Messages
6,127,530
Members
449,385
Latest member
KMGLarson

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