box all columns and rows

[Trevor3007]

hi,

does anyone have the vb to only box col\rows that contain text?

at present i use:-

Sub boarder()'
' boarder Macro
'


'
    Range("A1:F2663").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThick
    End With
End Sub

I am going to be using various user made excel sheets & they will be all different formats etc.

MTIA
KR
Trevor3007

 

[Trevor3007]

Maybe this then....

Sub MM1()
ActiveSheet.UsedRange.Borders.Weight = xlThick
End Sub

is it possible to run this automatically..ie if the crrent boxed area is a1 - d20 & i add data into e18, it will run the applicable vb & the boxed area will now ne a1- e20?

fingers crossed & thank you

 

[Trevor3007]

fantastic.... works a treat.

thank you & hope you have a great Xmas.
KR Trevor3007

good afternoon,

thank you for your help. I have managed to sort using the following:-




I added

Private Sub Worksheet_Change(ByVal Target As Range

before your code & now any time i add new data a previously unboxed cell , it is now 'boxed'

I now need to sort how to autodelate rows with NO data in !!!

many thanks

 

[MARK858]

I now need to sort how to autodelate rows with NO data in !!!

Although I am not a fan of triggering it as an auto delete try adding the below to the end of your code...

    Dim FirstRow As Long, LastRow As Long, i As Long
    With ActiveSheet.UsedRange
        FirstRow = .Row
        LastRow = .SpecialCells(11).Row
    End With
    For i = LastRow To FirstRow Step -1
        If WorksheetFunction.CountA(Rows(i)) = 0 Then Rows(i).Delete
    Next

 

[Trevor3007]

Although I am not a fan of triggering it as an auto delete try adding the below to the end of your code...

    Dim FirstRow As Long, LastRow As Long, i As Long
    With ActiveSheet.UsedRange
        FirstRow = .Row
        LastRow = .SpecialCells(11).Row
    End With
    For i = LastRow To FirstRow Step -1
        If WorksheetFunction.CountA(Rows(i)) = 0 Then Rows(i).Delete
    Next

thanks mark,

Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.UsedRange.Borders.Weight = xlThick
Dim FirstRow As Long, LastRow As Long, i As Long
    With ActiveSheet.UsedRange
        FirstRow = .Row
        LastRow = .SpecialCells(11).Row
    End With
    For i = LastRow To FirstRow Step -1
        If WorksheetFunction.CountA(Rows(i)) = 0 Then Rows(i).Delete
    Next
End Sub

I added as you suggested (see above) and received the following ;-

Runtime error 1004 deleted method out of range
& it highlighted
Rows(i).Delete

in yellow

it also added several rows , eventhough there was no data\txt in the rows ?

Where did i go wrong?

MYIA
KR
Trevor3007

 

[MARK858]

Try the code below....

Private Sub Worksheet_Change(ByVal Target As Range)
    ActiveSheet.UsedRange.Borders.Weight = xlThick
    Dim FirstRow As Long, LastRow As Long, i As Long
    Application.EnableEvents = False
    With ActiveSheet.UsedRange
        FirstRow = .Row
        LastRow = .SpecialCells(11).Row
    End With
    For i = LastRow To FirstRow Step -1
        If WorksheetFunction.CountA(Rows(i)) = 0 Then Rows(i).Delete
    Next
    Application.EnableEvents = True
End Sub

Also make sure that you have no sheet protection.

 

[Trevor3007]

Try the code below....

Private Sub Worksheet_Change(ByVal Target As Range)
    ActiveSheet.UsedRange.Borders.Weight = xlThick
    Dim FirstRow As Long, LastRow As Long, i As Long
    Application.EnableEvents = False
    With ActiveSheet.UsedRange
        FirstRow = .Row
        LastRow = .SpecialCells(11).Row
    End With
    For i = LastRow To FirstRow Step -1
        If WorksheetFunction.CountA(Rows(i)) = 0 Then Rows(i).Delete
    Next
    Application.EnableEvents = True
End Sub

Also make sure that you have no sheet protection.

thats it !!! pure magic!!! thank you ,

All the very best and am sure you will come to my aid again.

KR
Tevor

 

[Rick Rothstein]

thats it !!! pure magic!!! thank you ,

I had trouble with Trevor's code when I deleted some values located on the outside edges of the data... the boxed cells did not change to reflect the new data layout. This is a problem when using the UsedRange... sometimes it updates correctly and other times it does not. Here is an alternate Change event procedure which will not suffer from that possible problem...

[table="width: 500"]
[tr]
	[td]Private Sub Worksheet_Change(ByVal Target As Range)
  Dim FirstRow As Long, FirstCol As Long, LastRow As Long, LastCol As Long, FilledCells As Long
  On Error GoTo EverythingWasDeleted
  FilledCells = xlValues [B][COLOR="#FF0000"]'Choices are xlValues or xlFormulas[/COLOR][/B]
  Cells.Borders.LineStyle = 0
  FirstRow = Cells.Find("*", Cells(Rows.Count, "A"), FilledCells, , xlRows, xlNext, , , False).Row
  FirstCol = Cells.Find("*", Cells(1, Columns.Count), FilledCells, , xlByColumns, xlNext, , , False).Column
  LastRow = Cells.Find("*", , FilledCells, , xlRows, xlPrevious, , , False).Row
  LastCol = Cells.Find("*", , FilledCells, , xlByColumns, xlPrevious, , , False).Column
  Range(Cells(FirstRow, FirstCol), Cells(LastRow, LastCol)).Borders.Weight = xlThick
EverythingWasDeleted:
End Sub[/td]
[/tr]
[/table]

I would also like to draw your attention to what I highlighted in red above. There are two possible values that can be assigned to the FilledCells variable... xlValues or xlFormulas. I used xlValues in the code above which means only cells displaying a value will be used to determine the range to box. If you change the assignment to xlFormulas, then cells containing formulas that are displaying the empty text string ("") will also be used to determine the range to box.

 

[Trevor3007]

Try the code below....

Private Sub Worksheet_Change(ByVal Target As Range)
    ActiveSheet.UsedRange.Borders.Weight = xlThick
    Dim FirstRow As Long, LastRow As Long, i As Long
    Application.EnableEvents = False
    With ActiveSheet.UsedRange
        FirstRow = .Row
        LastRow = .SpecialCells(11).Row
    End With
    For i = LastRow To FirstRow Step -1
        If WorksheetFunction.CountA(Rows(i)) = 0 Then Rows(i).Delete
    Next
    Application.EnableEvents = True
End Sub

Also make sure that you have no sheet protection.

Hi Mark,

Sorry to ask, but due to a major change is it possible to amend your code so it will only grid in a range IE a1:c200 ?

I did try myself , but only AGAIN messed it up.

here is the code BTW

Private Sub Worksheet_Change(ByVal Target As Range)
    ActiveSheet.UsedRange.Borders.Weight = xlThick
    Dim FirstRow As Long, LastRow As Long, i As Long
    Application.EnableEvents = False
    With ActiveSheet.UsedRange
        FirstRow = .Row
        LastRow = .SpecialCells(11).Row
    End With
    For i = LastRow To FirstRow Step -1
        If WorksheetFunction.CountA(Rows(i)) = 0 Then Rows(i).Delete
    Next
    Application.EnableEvents = True
End Sub

MTIA
Trevor

 

[MARK858]

Not sure exactly what you want but try the below as a start

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim lRow As Long, FirstRow As Long, i As Long
    If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
    
    Application.EnableEvents = False

    If Not Intersect(Target, Range("A1:C200")) Is Nothing Then
        Range("A1:C200").Borders.LineStyle = xlNone
        lRow = Range("A1:C200").Find("*", , xlValues, , xlByRows, xlPrevious).Row
        Range("A1:C" & lRow).Borders.Weight = xlThick

        For i = lRow To 1 Step -1
            If WorksheetFunction.CountA(Rows(i)) = 0 Then Rows(i).Delete
        Next
    End If

    Application.EnableEvents = True
End Sub

 

[MARK858]

Correction...

Not sure exactly what you want but try the below as a start

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim lRow As Long, FirstRow As Long, i As Long

    Range("A1:C200").Borders.LineStyle = xlNone
    If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub

    Application.EnableEvents = False

    If Not Intersect(Target, Range("A1:C200")) Is Nothing Then

        lRow = Range("A1:C200").Find("*", , xlValues, , xlByRows, xlPrevious).Row
        Range("A1:C" & lRow).Borders.Weight = xlThick

        For i = lRow To 1 Step -1
            If WorksheetFunction.CountA(Rows(i)) = 0 Then Rows(i).Delete
        Next
    End If

    Application.EnableEvents = True
End Sub