VBA code to alter specific range to selection

[heathball]

This code is working well. I want to improve it.

I have two goals.

I cannot make any impact when i try to solve this, which makes me think it needs a different approach if I am going to achieve it.

1. it currently requires a range to be entered. eg. bt2:bt
For Each xrg In Range("bt2:bt" & LastRow - 1)

I am trying to get it to work on the "selection" -which in practice would normallly be the selection of an entire column

for eg, something like a
with selection
'code in here'
end with

may work, but did not work for me.


2. with this required range for the choice of how far the border extends (left to right) eg. LK
Range("A" & xrg.row & ":LK" & xrg.row).BORDERS(xlEdgeBottom).Weight = xlMedium

Can this be set to choose the "LastColumn (last column or cell used) plus the next 50 columns" and not require the actual cell reference to be input.



Hope someone can help, Thanks in advance.

Sub BORDER_CRITERIA()
'CREATES A ROW BORDER AT THE POINT WHERE THERE IS A CELL CHANGE WITHIN A COLUMN

 
 

     Application.ScreenUpdating = False
    Dim LastRow As Long
    Dim xrg As Range
    
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).row
    For Each xrg In Range("bt2:bt" & LastRow - 1)
        If xrg <> xrg.Offset(1, 0) Then
            Range("A" & xrg.row & ":LK" & xrg.row).BORDERS(xlEdgeBottom).Weight = xlMedium
            
        End If
    Next xrg
    Application.ScreenUpdating = True
End Sub

 

[Joe4]

Maybe something like this:

Number 1:

Dim cell as Range
For Each cell in Selection
   'code here
Next cell

Number 2:

    Dim lastCol As Long
    lastCol = Range("A1").SpecialCells(xlLastCell).Column
    Range(Cells(xrg.Row, 1), Cells(srg.Row, lastCol + 50)).Borders(xlEdgeBottom).Weight = xlMedium

 

[heathball]

Joe, i got number 2 to work from your suggestion, thanks very much.

i have trouble with the actual specific changes that your number 1 code requires.

Sub BORDER_CRITERIA22()
'CREATES A ROW BORDER AT THE POINT WHERE THERE IS A CELL CHANGE WITHIN A COLUMN

 
 
    
     Application.ScreenUpdating = False
    Dim LastRow As Long
    Dim xrg As Range
Dim lastCol As Long


    lastCol = Range("A1").SpecialCells(xlLastCell).Column


    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).row
  For Each xrg In Range("bt2:bt" & LastRow - 1)
        If xrg <> xrg.Offset(1, 0) Then
        Range(Cells(xrg.row, 1), Cells(xrg.row, lastCol + 50)).BORDERS(xlEdgeBottom).Weight = xlMedium
        End If

      
        
    Next xrg
   
    Application.ScreenUpdating = True
End Sub

 

[Joe4]

i have trouble with the actual specific changes that your number 1 code requires.

What exactly is the issue?
Please explain what you want to happen and what actually is happening.
We may need to see a snapshot of the section of data involved to understand your data structure, which could affect what the code does.

 

[heathball]

there is nothing happening. no break in code. just nothing happens.

i am not sure what to do with this line....

For Each xrg In Range("bt2:bt" & LastRow - 1)


or there is another problem with how i have placed the code.

Sub BORDER_CRITERIa33()
'CREATES A ROW BORDER AT THE POINT WHERE THERE IS A CELL CHANGE WITHIN A COLUMN

 
 
   
     Application.ScreenUpdating = False
    Dim LastRow As Long
    Dim xrg As Range
Dim lastCol As Long


    lastCol = Range("A1").SpecialCells(xlLastCell).Column
Dim cell As Range
For Each cell In selection
   LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).row
  For Each xrg In Range("bt2:bt" & LastRow - 1)
        If xrg <> xrg.Offset(1, 0) Then
        Range(Cells(xrg.row, 1), Cells(xrg.row, lastCol + 50)).BORDERS(xlEdgeBottom).Weight = xlMedium
        End If



   
     
       
    Next xrg
   Next cell
    Application.ScreenUpdating = True
End Sub

 

[Joe4]

I thought that you said that instead of running it against the range "Range("bt2:bt" & LastRow - 1)", you wanted to run it against the current selection?
If that is the case, just replace your range with "Selection", which is a valid range object, i.e.
change:

For Each xrg In Range("bt2:bt" & LastRow - 1)

to this:

For Each xrg In Selection

If that is not what you are after, then you need to try explaining it again (as that is what it appears that you are asking to me).

 

[heathball]

I thought that you said that instead of running it against the range "Range("bt2:bt" & LastRow - 1)", you wanted to run it against the current selection?
If that is the case, just replace your range with "Selection", which is a valid range object, i.e.
change:

For Each xrg In Range("bt2:bt" & LastRow - 1)

to this:

For Each xrg In Selection

If that is not what you are after, then you need to try explaining it again (as that is what it appears that you are asking to me).

thank you. it is what i am after!

the LastRow - 1 in
For Each xrg In Range("bt2:bt" & LastRow - 1)

ignores the final row and there is no border there. whch is my goal.
How can i add this feature to the code, as it doesn't seem to operate when i try options.

 

[heathball]

this is what i have now.

Sub BORDER_CRITERIa33()
'CREATES A ROW BORDER AT THE POINT WHERE THERE IS A CELL CHANGE WITHIN A COLUMN

 
 
    
     Application.ScreenUpdating = False
    Dim LastRow As Long
    Dim xrg As Range
Dim lastCol As Long


    lastCol = Range("A1").SpecialCells(xlLastCell).Column
Dim cell As Range
For Each cell In selection
   LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).row
  For Each xrg In selection
        If xrg <> xrg.Offset(1, 0) Then
        Range(Cells(xrg.row, 1), Cells(xrg.row, lastCol + 50)).BORDERS(xlEdgeBottom).Weight = xlMedium
        End If



    
      
        
    Next xrg
   Next cell
    Application.ScreenUpdating = True
End Sub

 

[Joe4]

I am sorry, I still do not understand what you are asking. There are no errors in your code.
I am guessing that the issue is how the code relates to your data and what you actually want to happen versus what is really happening.

I think it would be much better if you show us a sample of your data (the part affected by this code), and show us what you want to happen.
An example often goes a long way in explaining/showing exactly what you are trying to do.

MrExcel has a tool called “XL2BB” that lets you post samples of your data that will allow us to copy/paste it to our Excel spreadsheets, so we can work with the same copy of data that you are. Instructions on using this tool can be found here: XL2BB Add-in

Note that there is also a "Test Here” forum on this board. This is a place where you can test using this tool (or any other posting techniques that you want to test) before trying to use those tools in your actual posts.

 

[heathball]

I am sorry, I still do not understand what you are asking. There are no errors in your code.
I am guessing that the issue is how the code relates to your data and what you actually want to happen versus what is really happening.

I think it would be much better if you show us a sample of your data (the part affected by this code), and show us what you want to happen.
An example often goes a long way in explaining/showing exactly what you are trying to do.

MrExcel has a tool called “XL2BB” that lets you post samples of your data that will allow us to copy/paste it to our Excel spreadsheets, so we can work with the same copy of data that you are. Instructions on using this tool can be found here: XL2BB Add-in

Note that there is also a "Test Here” forum on this board. This is a place where you can test using this tool (or any other posting techniques that you want to test) before trying to use those tools in your actual posts.

I perhaps did not explain what is a simple idea, clearly enough.
There are no errors in the code.

With the part below in red, which is my original code
For Each xrg In Range("bt2:bt" & LastRow - 1)
the code would not add a border to the last row used.

This causes issues with the files i have.

with the new method, via selection----
Is there a way to add this to the code - so that there is no border applied to the last row on the sheet (my selection is to the last row)