How to detect if a cell has border and where?

[JohnPoole]

Hi all, I'm hoping somebody can advise how to write a small vba script which will look at cell and determine if it has border, and on which sides?

I've tried the example from help with a few variations, but cant seem to get it working.

Any advice appreciated.

 

[Gerald Higgins]

Hi. Can you explain why you want to do this ?
Is it an option to simply apply borders to some sides, regardless of whether they are already there or not ?

 

[Jon von der Heyden]

Perhaps this will give you an idea and you can integrate into your project:

[COLOR=blue]Option[/COLOR] [COLOR=blue]Explicit[/COLOR]
[COLOR=#0000ff][/COLOR] 
[COLOR=blue]Public[/COLOR] [COLOR=blue]Function[/COLOR] BorderInfo([COLOR=blue]ByVal[/COLOR] rngCell [COLOR=blue]As[/COLOR] Range)
 
    [COLOR=blue]Dim[/COLOR] strResult [COLOR=blue]As[/COLOR] [COLOR=blue]String[/COLOR]
    [COLOR=blue]Dim[/COLOR] blnHasBorder [COLOR=blue]As[/COLOR] [COLOR=blue]Boolean[/COLOR]
[COLOR=#0000ff][/COLOR] 
    [COLOR=blue]If[/COLOR] rngCell.Count > 1 [COLOR=blue]Then[/COLOR] [COLOR=blue]Exit[/COLOR] [COLOR=blue]Function[/COLOR]
 
    blnHasBorder = rngCell.Borders(xlEdgeLeft).LineStyle <> xlNone
    strResult = strResult & "; Left:=" & [COLOR=blue]CStr[/COLOR](blnHasBorder)
 
    blnHasBorder = rngCell.Borders(xlEdgeRight).LineStyle <> xlNone
    strResult = strResult & "; Right:=" & [COLOR=blue]CStr[/COLOR](blnHasBorder)
 
    blnHasBorder = rngCell.Borders(xlEdgeTop).LineStyle <> xlNone
    strResult = strResult & "; Top:=" & [COLOR=blue]CStr[/COLOR](blnHasBorder)
 
    blnHasBorder = rngCell.Borders(xlEdgeBottom).LineStyle <> xlNone
    strResult = strResult & "; Bottom:=" & [COLOR=blue]CStr[/COLOR](blnHasBorder)
 
    BorderInfo = [COLOR=blue]Mid$[/COLOR](strResult, 2)
[COLOR=blue][/COLOR] 
[COLOR=blue]End[/COLOR] [COLOR=blue]Function[/COLOR]
 
[COLOR=blue]Sub[/COLOR] TestFunction()
    [COLOR=blue]Debug.Print[/COLOR] BorderInfo(ActiveCell)
[COLOR=blue]End[/COLOR] [COLOR=blue]Sub[/COLOR]

 

[JohnPoole]

Thanks for that, that works perfectly, your help is appreciated

 

[jim may]

If My Cell C2 has a Bottom ONLY Border
and My Cell D2 has a Left ONLY Border

It appears that C2 INHERITS the Left Border of D2 thinking C2 has A Right Border
delivering True for both Bottom and Right for Cell C2

Isn't this a problem?

 

[Jon von der Heyden]

Ah I didn't realise that. Strange behaviour because if you insert a new column from D then it will shift D2 to E2 and C2 no longer inherits the border.

That function could be alot tidier but I was trying to illustrate the method. But I will revisit and post a reworked solution.

 

[Jon von der Heyden]

No doubt there is a better way but it eludes me:

[COLOR=blue]Option[/COLOR] [COLOR=blue]Explicit[/COLOR]
[COLOR=#0000ff][/COLOR] 
[COLOR=blue]Public[/COLOR] [COLOR=blue]Enum[/COLOR] posBorder
    posLeft
    posRight
    posTop
    posBottom
[COLOR=blue]End[/COLOR] [COLOR=blue]Enum[/COLOR]
[COLOR=#0000ff][/COLOR] 
[COLOR=blue]Public[/COLOR] [COLOR=blue]Function[/COLOR] BorderInfo([COLOR=blue]ByVal[/COLOR] rngCell [COLOR=blue]As[/COLOR] Range, [COLOR=blue]ByVal[/COLOR] pos [COLOR=blue]As[/COLOR] posBorder) [COLOR=blue]As[/COLOR] [COLOR=blue]Boolean[/COLOR]
[COLOR=#0000ff][/COLOR] 
    [COLOR=blue]Dim[/COLOR] lngCalc [COLOR=blue]As[/COLOR] [COLOR=blue]Long[/COLOR]
 
    [COLOR=blue]With[/COLOR] Application
        .ScreenUpdating = [COLOR=blue]False[/COLOR]
        .EnableEvents = [COLOR=blue]False[/COLOR]
        lngCalc = .Calculation
        .Calculation = xlManual
    [COLOR=blue]End[/COLOR] [COLOR=blue]With[/COLOR]
[COLOR=#0000ff][/COLOR] 
    [COLOR=blue]On[/COLOR] [COLOR=blue]Error[/COLOR] [COLOR=blue]GoTo[/COLOR] Finally
 
    [COLOR=blue]If[/COLOR] rngCell.Count > 1 [COLOR=blue]Then[/COLOR] [COLOR=blue]GoTo[/COLOR] Finally
    [COLOR=blue]If[/COLOR] rngCell.Column = Columns.Count [COLOR=blue]Then[/COLOR] [COLOR=blue]GoTo[/COLOR] Finally
    [COLOR=blue]If[/COLOR] rngCell.Row = Rows.Count [COLOR=blue]Then[/COLOR] [COLOR=blue]GoTo[/COLOR] Finally
 
    [COLOR=blue]With[/COLOR] rngCell
        [COLOR=blue]If[/COLOR] pos = posLeft [COLOR=blue]Then[/COLOR]
            .EntireColumn.Insert
            BorderInfo = .Borders(xlEdgeLeft).LineStyle <> xlNone
            .Offset(, -1).EntireColumn.Delete
        [COLOR=blue]ElseIf[/COLOR] pos = posRight [COLOR=blue]Then[/COLOR]
            .Offset(, 1).EntireColumn.Insert
            BorderInfo = .Borders(xlEdgeRight).LineStyle <> xlNone
            .Offset(0, 1).EntireColumn.Delete
        [COLOR=blue]ElseIf[/COLOR] pos = posTop [COLOR=blue]Then[/COLOR]
            .EntireRow.Insert
            BorderInfo = .Borders(xlEdgeTop).LineStyle <> xlNone
            .Offset(-1).EntireRow.Delete
        [COLOR=blue]ElseIf[/COLOR] pos = posBottom [COLOR=blue]Then[/COLOR]
            .Offset(1).EntireRow.Insert
            BorderInfo = .Borders(xlEdgeBottom).LineStyle <> xlNone
            .Offset(1).EntireRow.Delete
        [COLOR=blue]End[/COLOR] [COLOR=blue]If[/COLOR]
    [COLOR=blue]End[/COLOR] [COLOR=blue]With[/COLOR]
 
Finally:
    [COLOR=blue]With[/COLOR] Application
        .ScreenUpdating = [COLOR=blue]True[/COLOR]
        .Calculation = lngCalc
        .EnableEvents = [COLOR=blue]True[/COLOR]
    [COLOR=blue]End[/COLOR] [COLOR=blue]With[/COLOR]
[COLOR=blue][/COLOR] 
[COLOR=blue]End[/COLOR] [COLOR=blue]Function[/COLOR]
 
[COLOR=blue]Sub[/COLOR] testIT()
    [COLOR=blue]Debug.Print[/COLOR] "Left:= "; BorderInfo(ActiveCell, posLeft)
    [COLOR=blue]Debug.Print[/COLOR] "Right:= "; BorderInfo(ActiveCell, posRight)
    [COLOR=blue]Debug.Print[/COLOR] "Top:= "; BorderInfo(ActiveCell, posTop)
    [COLOR=blue]Debug.Print[/COLOR] "Bottom:= "; BorderInfo(ActiveCell, posBottom)
[COLOR=blue]End[/COLOR] [COLOR=blue]Sub[/COLOR]

 

[JohnPoole]

Well, I've been using the second version of this successfully since it was posted thanks. I have some questions / requests.

Could the function and the test procedure be modified so that rather than looking at just the activecell to see if it has borders on each side of the cell , it would report how many cells up,down,left and right away the nearest border was? An example would be :
Active cell is B5. A bottom border exists on B3, so the 'up' result would be 2.

Hope that makes sense, help appreciated as always.

 

[Norie]

John

I've got to echo Gerald's question - why do you want to do this?

 

[JohnPoole]

This is a practice excercise I've set myself, ultimatley to create a map/maze ( I know its boring to most people) to increase my vb skills. It's nesscary for me to be able to calculate how may cells away the nearest cell border is in each direction.

I have modified the orginal post by inserting an offset into the function, but I need seperate fucntion for each offset i do.
eg
BorderInfo = .Offset(0, -5).Borders(xlEdgeLeft).LineStyle <> xlNone

Hope that helps.