VBA for adding borders to a range based on condition?

**antonymiller** · 07-12-2009, 04:16 PM

Hi Krish -

Thanks a lot, this is way simpler than the approach i was trying to take. I failed to represent in my original post that there is a empty row between each data entry.

___________________________________________________________

7/11/09 Tool1
EMPTY ROW
7/12/09 Tool 1
___________________________________________________________

___________________________________________________________
7/11/09 Tool3
EMPTY ROW
7/12/09 Tool3 etc.
___________________________________________________________

How can account for these empty rows between tool entries and still manage to get the borders around the range of cells for that particular tool?

Thanks

**Krishnakumar** · 07-12-2009, 10:24 PM

Still not sure about your layout. Post an attachment here.

Kris

**antonymiller** · 07-12-2009, 10:48 PM

Hi Kris,

Here is the attachment- it pretty much outlines what I'm shooting for.
Mainly just need to figure out how to get the borders to appear around the perimeter of the first and last row a particular tool number appears in.... the blank rows in between shouldn't have a top or bottom border.

Thanks again.

**Krishnakumar** · 07-13-2009, 02:19 PM

Hi,

There may be better solution...

Sub kTest()
Dim a, i As Long, v, x, y

With ActiveSheet
    a = .Range("b3:b" & .Range("b" & Rows.Count).End(xlUp).Row)
End With
v = UNIQUE(a)
For i = 1 To UBound(a, 1)
    If Not IsEmpty(a(i, 1)) Then
        y = Application.Match(a(i, 1), Application.Index(v, 0, 1), 0)
        x = Application.Index(v, y, 2)
        CreateBorder Cells(i + 2, "a").Resize(x * 2 - 2 + 1, 13)
        i = i + (x * 2 - 2 + 1)
    End If
Next
End Sub
Function UNIQUE(v)
Dim i, w(), n As Long, r()
ReDim w(1 To UBound(v, 1), 1 To 2)
With CreateObject("scripting.dictionary")
    .comparemode = 1
    For Each i In v
        If Not IsEmpty(i) Then
            If Not .exists(i) Then
                n = n + 1: w(n, 1) = i: w(n, 2) = 1
                .Add i, Array(n, 2)
            Else
                r = .Item(i)
                w(r(0), 2) = w(r(0), 2) + 1
                .Item(i) = r
            End If
        End If
    Next
End With
If n > 0 Then UNIQUE = w
End Function
Sub CreateBorder(ByRef r As Range)
With r
    .Borders(xlDiagonalDown).LineStyle = xlNone
    .Borders(xlDiagonalUp).LineStyle = xlNone
    .Borders(xlEdgeLeft).LineStyle = xlNone
    .Borders(xlEdgeTop).LineStyle = xlNone
    .Borders(xlEdgeBottom).LineStyle = xlNone
    .Borders(xlEdgeRight).LineStyle = xlNone
    .Borders(xlInsideVertical).LineStyle = xlNone
    .Borders(xlInsideHorizontal).LineStyle = xlNone
    .Borders(xlDiagonalDown).LineStyle = xlNone
    .Borders(xlDiagonalUp).LineStyle = xlNone
    .Borders(xlEdgeLeft).LineStyle = xlNone
    With .Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With .Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    .Borders(xlEdgeRight).LineStyle = xlContinuous
    .Borders(xlEdgeLeft).LineStyle = xlContinuous
    .Borders(xlInsideVertical).LineStyle = xlNone
    .Borders(xlInsideHorizontal).LineStyle = xlNone
End With
End Sub

HTH

**antonymiller** · 07-13-2009, 05:48 PM

Kris,

It's perfect thanks - it would have been a while before i got this far on my own.... thanks a million!

**antonymiller** · 07-17-2009, 01:24 AM

I've been trying my hardest to apply the macro help I've received to other worksheets I use. With little luck.

Specifically, I have an inventory sheet that isn't vary complicated. I do a custom sort on it and everything condenses rather nicely but it is undreadable. So I've been asked to add empty rows between each line. The macro I am trying to use doesn't effect the entire row, only the first cell and it moves the headers as well. My limited knowledge is a problem in fixing that.

My second macro is meant to place a single box border around all the rows that contain the same ID number - all unique ID's are boxed in together for easier reading. Again, it just isn't working out that way. Mainly because I can't figure out how to alter to box things in correctly.

this is a macro that I'd really like to learn from as this is the kind of thing I get asked to do all the time, and I hate having to do it manually - takes forever.

I know both of these macros work - I got them here from very helpful people and have used them already in other forms successfully. I just don't understand VBA well enough yet to get them to work in a new worksheet with different layouts.

I have attached my workbook - any assistance would be appreciated.

Thanks

**Krishnakumar** · 07-17-2009, 12:58 PM

Hi,

To insert the rows use first macro and the nrun the second macro to create the border.

Option Explicit
Sub Skip_Row_After_Custom_Sort()
Dim lRow As Long, i As Long

Application.ScreenUpdating = 0
lRow = Range("b" & Rows.Count).End(xlUp).Row
For i = lRow To 8 Step -1
    If Cells(i, "b") <> Cells(i - 1, "b") Then Rows(i).Insert
Next
Application.ScreenUpdating = 1
End Sub
Sub BuildBorder()
Dim Rng As Range, r As Range

Set Rng = Range("b9", Range("b" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeConstants)

For Each r In Rng.Areas
    CreateBorder r.Cells(1, 1).Offset(, -1).Resize(r.Rows.Count, 22)
Next
End Sub

HTH