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]

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

morning Mark,

thanks for your help.

All appeared good, but if any data is removed in any of the cells. the whole grid disappears irrespectively if there is data in that row, whereas your other code just removed the grid col if it was blank


so sorry to hassle .
KR
Trevor
.
.

 

[MARK858]

I'll have a look at this when I get back in this evening but can I ask why you aren't using conditional formatting for this as it is much slimpler (and probably more efficient than using a change event on every cell in the range which it seems we will have to)?

 

[Trevor3007]

I'll have a look at this when I get back in this evening but can I ask why you aren't using conditional formatting for this as it is much slimpler (and probably more efficient than using a change event on every cell in the range which it seems we will have to)?

hi mark,

thank you for getting back to me.

in answer to your question' why you aren't using conditional formatting for this as it is much simpler' CF would not 'grid' ( i only ever use CF to detect 'duplicates' ) & it wont grid auto. I have to put data from 3rd party wokbooks\sheets into a master before it is passed onto the next person.

Most of the 3rd party workbooks\sheets are messy where as my 'master' is 'uniformed. Your code will eradicate rows of 'blanks' and grid the applicable..

your code:-

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

works great, but due to a change in requirements, I need this only to impact range a2:c200.


My method may seem 'long winded' but ATM its the best method for me.

Many thanks again Mark & I look forward to your next update.
KR & MTIA
Trevor3007

 

[Rick Rothstein]

I need this only to impact range a2:c200.

If I understand your requirements correctly, I believe this Change event code will do what you want...

[table="width: 500"]
[tr]
	[td]Private Sub Worksheet_Change(ByVal Target As Range)
  Dim FirstCol As Long, LastRow As Long, LastCol As Long, FilledCells As Long
  On Error GoTo Whoops
  Application.EnableEvents = False
  Application.ScreenUpdating = False
  [A2:A200] = [IF(A2:A200&B2:B200&C2:C200="","#N/A",IF(A2:A200="","",A2:A200))]
  Intersect([A2:A200].SpecialCells(xlConstants, xlErrors).EntireRow, [A:C]).Delete xlShiftUp
  Cells.Borders.LineStyle = 0
  FirstCol = [A2:C200].Find("*", [C200], xlValues, , xlByColumns, xlNext, , , False).Column
  LastRow = [A2:C200].Find("*", , xlValues, , xlRows, xlPrevious, , , False).Row
  LastCol = [A2:C200].Find("*", , xlValues, , xlByColumns, xlPrevious, , , False).Column
  Range(Cells(2, FirstCol), Cells(LastRow, LastCol)).Borders.Weight = xlThick
Whoops:
  Application.ScreenUpdating = True
  Application.EnableEvents = True
End Sub[/td]
[/tr]
[/table]