Using a macro to generate segregation lines

I am trying to create a macro that will generate a segregation line between each Rep's business (column A).  (see example - Sheet 2).
The sample attached has about 100 lines of data and three or four Reps.  However, my real data could contain upwards of 4,000 lines.  Also, I would like to automatically create a RED border around column F and columns Z, AA (as one double column).  The problem I am having, is that each time I generate the data, the number of lines changes.  I would want the macro to decide where the end of the data is and create the borders based on the end of the data.

Sheet 1 contains the data as it appears today.  
Sheet 2 contains the data with a sample of how I am trying to 'auto format'.

Any help or guidance would be greatly appreciated.

Thanks.
SabealgoAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

SimonCommented:
Please post the sample worksheet you described in your question.
0
SabealgoAuthor Commented:
It is attached now.
Sample-Data.xlsx
0
Martin LissOlder than dirtCommented:
Where do you want the top of the red border to be? Row 1? Row 2? Row 3?
0
SimonCommented:
This will do it. Paste the code block into a module. It contains the 'AddBorders' sub and a separate sub to apply the red outline formatting. It uses the 'resize' and 'offset' functions to omit the title rows. You can change the values for the number of rows to exclude as required.

Sub AddBorders()
Const NumberOfTitleRows As Integer = 2
Dim usedRng As Range
Dim checkRng As Range
Dim formatRng As Range
Set usedRng = ActiveSheet.UsedRange
Set checkRng = Intersect(usedRng, Columns(1))
Set checkRng = checkRng.Resize(checkRng.Rows.Count - NumberOfTitleRows).Offset(NumberOfTitleRows, 0)
For Each c In checkRng
    If c.Value <> "" Then
    With Intersect(c.EntireRow, usedRng).Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .TintAndShade = 0
        .Weight = xlThick
    End With
    End If
Next

Set formatRng = Intersect(usedRng, Columns("F"))
Set formatRng = formatRng.Resize(formatRng.Rows.Count - 1).Offset(1, 0)
Call RedOutlineFormat(formatRng)

Set formatRng = Intersect(usedRng, Columns("z:aa"))
Set formatRng = formatRng.Resize(formatRng.Rows.Count - 1).Offset(1, 0)
Call RedOutlineFormat(formatRng)
End Sub


Sub RedOutlineFormat(rng As Range)
    rng.Borders(xlDiagonalDown).LineStyle = xlNone
    rng.Borders(xlDiagonalUp).LineStyle = xlNone
    With rng.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Color = -16776961
        .TintAndShade = 0
        .Weight = xlThick
    End With
    With rng.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Color = -16776961
        .TintAndShade = 0
        .Weight = xlThick
    End With
    With rng.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Color = -16776961
        .TintAndShade = 0
        .Weight = xlThick
    End With
    With rng.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Color = -16776961
        .TintAndShade = 0
        .Weight = xlThick
    End With
End Sub

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
SabealgoAuthor Commented:
Thank you for your help.  This works exactly as I needed and you saved me a ton of time.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Office Productivity

From novice to tech pro — start learning today.