Code for Cell border styling

[namz]

Guys,

I have an excel sheet that is pulling data from other sheet based on some cretaria...i want a macro that when ran on this excel fixes column width , makes cell border as "dotted" and outline the area with Thick Outline.


This is what a macro code should do ; Hope this makes sense...thanks.
1. Finds numeric values in rows falling in colum B,C,D,E , than border those cells as dotted (i.e. right click on cell - format column - Border - Style - 3rs on top left row).

2. After filling cell border style as mentioned above , macro should do a THICK BOX BORDER around a cells falling above dotted cells.. i.e. one big sqaure outlined contaiing dotted cells with numeric values.

3. Trick part , my sheet is divided into 2 parts , INTERNAL and EXTERNAL. So i have writen "INTERNAL" in A1 cell and EXTERNAL in 'A' row in last row after INTERNAL lines. So the THICK BOX BORDER as requested in pt 2 shud be separted ones for INTERNAL and sep from EXTERNAL.

This post is in continuance of my earlier post..

[Shijesh Kumar]

Hi,

I have done the following coding for you.
Assumption:
A2 should alway contain "Internal"

Sub format_it()


    Range("A2:E4").Interior.ColorIndex = 15

    Dim r As Long
    r = 5
    Do While Cells(r, 1) <> "INT Total"
        r = r + 1
    Loop
    r = r - 1




    If r >= 6 Then
        Range("b5", Cells(r, 5)).Select
        With Selection
            .BorderAround Weight:=xlMedium
            .Borders(xlInsideVertical).LineStyle = xlDot
            .Borders(xlInsideHorizontal).LineStyle = xlDot
        End With
     End If
     
     Dim r2 As Long
     
     r2 = r + 5
     Range(Cells(r + 1, 1), Cells(r + 6, 5)).Interior.ColorIndex = 15
     
     
     
     Do While Cells(r2, 1) <> "EXT Total"
        r2 = r2 + 1
    Loop
    r2 = r2 - 1
     
     
     
     
        Range(Cells(r + 7, 2), Cells(r2, 5)).Select
        With Selection
            .BorderAround Weight:=xlMedium
            .Borders(xlInsideVertical).LineStyle = xlDot
            .Borders(xlInsideHorizontal).LineStyle = xlDot
        End With
    Range(Cells(r2 + 1, 1), Cells(r2 + 1, 5)).Interior.ColorIndex = 15
    Range(Cells(r2 + 2, 1), Cells(r2 + 2, 5)).Interior.ColorIndex = 45
End Sub

[namz]

that worked like charm...all good..just what i was looking for...
can we make some adjustment in code so that it runs for all worksheet available in an excel sheet ??

[Shijesh Kumar]

Here is the modified code which will work for all the active sheet.

Sub format_it()


    ActiveSheet.Range("A2:E4").Interior.ColorIndex = 15

    Dim r As Long
    r = 5
    Do While Cells(r, 1) <> "INT Total"
        r = r + 1
    Loop
    r = r - 1




    If r >= 6 Then
        ActiveSheet.Range("b5", Cells(r, 5)).Select
        With Selection
            .BorderAround Weight:=xlMedium
            .Borders(xlInsideVertical).LineStyle = xlDot
            .Borders(xlInsideHorizontal).LineStyle = xlDot
        End With
     End If
     
     Dim r2 As Long
     
     r2 = r + 5
     ActiveSheet.Range(Cells(r + 1, 1), Cells(r + 6, 5)).Interior.ColorIndex = 15
     
     
     
     Do While Cells(r2, 1) <> "EXT Total"
        r2 = r2 + 1
    Loop
    r2 = r2 - 1
     
     
     MsgBox (r2 - r)
     If (r2 - r) >= 6 Then
        ActiveSheet.Range(Cells(r + 7, 2), Cells(r2, 5)).Select
        With Selection
            .BorderAround Weight:=xlMedium
            .Borders(xlInsideVertical).LineStyle = xlDot
            .Borders(xlInsideHorizontal).LineStyle = xlDot
        End With
     End If
    ActiveSheet.Range(Cells(r2 + 1, 1), Cells(r2 + 1, 5)).Interior.ColorIndex = 15
    ActiveSheet.Range(Cells(r2 + 2, 1), Cells(r2 + 2, 5)).Interior.ColorIndex = 45
End Sub

[namz]

Here is the modified code which will work for all the active sheet.

Sub format_it()


    ActiveSheet.Range("A2:E4").Interior.ColorIndex = 15

    Dim r As Long
    r = 5
    Do While Cells(r, 1) <> "INT Total"
        r = r + 1
    Loop
    r = r - 1




    If r >= 6 Then
        ActiveSheet.Range("b5", Cells(r, 5)).Select
        With Selection
            .BorderAround Weight:=xlMedium
            .Borders(xlInsideVertical).LineStyle = xlDot
            .Borders(xlInsideHorizontal).LineStyle = xlDot
        End With
     End If
     
     Dim r2 As Long
     
     r2 = r + 5
     ActiveSheet.Range(Cells(r + 1, 1), Cells(r + 6, 5)).Interior.ColorIndex = 15
     
     
     
     Do While Cells(r2, 1) <> "EXT Total"
        r2 = r2 + 1
    Loop
    r2 = r2 - 1
     
     
     MsgBox (r2 - r)
     If (r2 - r) >= 6 Then
        ActiveSheet.Range(Cells(r + 7, 2), Cells(r2, 5)).Select
        With Selection
            .BorderAround Weight:=xlMedium
            .Borders(xlInsideVertical).LineStyle = xlDot
            .Borders(xlInsideHorizontal).LineStyle = xlDot
        End With
     End If
    ActiveSheet.Range(Cells(r2 + 1, 1), Cells(r2 + 1, 5)).Interior.ColorIndex = 15
    ActiveSheet.Range(Cells(r2 + 2, 1), Cells(r2 + 2, 5)).Interior.ColorIndex = 45
End Sub

Hi Shailesh , did not worked...still doing formatting for selected sheet plus..getting an app/object defined error in sheet where i do not have any external site...ERROR IS UNDERLINED IN BELOW PASTED CODE...

Sub format_it()


    ActiveSheet.Range("A2:E4").Interior.ColorIndex = 15

    Dim r As Long
    r = 5
    Do While Cells(r, 1) <> "INT Total"
        r = r + 1
    Loop
    r = r - 1




    If r >= 6 Then
        ActiveSheet.Range("b5", Cells(r, 5)).Select
        With Selection
            .BorderAround Weight:=xlMedium
            .Borders(xlInsideVertical).LineStyle = xlDot
            .Borders(xlInsideHorizontal).LineStyle = xlDot
        End With
     End If
     
     Dim r2 As Long
     
     r2 = r + 5
     ActiveSheet.Range(Cells(r + 1, 1), Cells(r + 6, 5)).Interior.ColorIndex = 15
     
     
     
     Do While Cells(r2, 1) <> "EXT Total"        r2 = r2 + 1
    Loop
    r2 = r2 - 1
     
     
     MsgBox (r2 - r)
     If (r2 - r) >= 6 Then
        ActiveSheet.Range(Cells(r + 7, 2), Cells(r2, 5)).Select
        With Selection
            .BorderAround Weight:=xlMedium
            .Borders(xlInsideVertical).LineStyle = xlDot
            .Borders(xlInsideHorizontal).LineStyle = xlDot
        End With
     End If
    ActiveSheet.Range(Cells(r2 + 1, 1), Cells(r2 + 1, 5)).Interior.ColorIndex = 15
    ActiveSheet.Range(Cells(r2 + 2, 1), Cells(r2 + 2, 5)).Interior.ColorIndex = 45
End Sub

[Shijesh Kumar]

I have attached the sheet.
if you press ctrl+t macros will run.

first run macros on this sheet to check is it working okey.
then try macros on some other sheet...


if it is not working then.. find what is the difference in the way data is present in other sheet.

My macros should function well.
if A2 contain Internal
and
There is a column called INT Total (irrespective of wheter data is there or not)