Solved

Using a macro to generate segregation lines

Posted on 2014-12-30
5
130 Views
Last Modified: 2014-12-30
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.
0
Comment
Question by:Sabealgo
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
  • 2
5 Comments
 
LVL 18

Expert Comment

by:Simon
ID: 40523813
Please post the sample worksheet you described in your question.
0
 

Author Comment

by:Sabealgo
ID: 40523818
It is attached now.
Sample-Data.xlsx
0
 
LVL 48

Expert Comment

by:Martin Liss
ID: 40523873
Where do you want the top of the red border to be? Row 1? Row 2? Row 3?
0
 
LVL 18

Accepted Solution

by:
Simon earned 500 total points
ID: 40523893
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
 

Author Closing Comment

by:Sabealgo
ID: 40524155
Thank you for your help.  This works exactly as I needed and you saved me a ton of time.
0

Featured Post

Supports up to 4K resolution!

The VS192 2-Port 4K DisplayPort Splitter is perfect for anyone who needs to send one source of DisplayPort high definition video to two or four DisplayPort displays. The VS192 can split and also expand DisplayPort audio/video signal on two or four DisplayPort monitors.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

You need to know the location of the Office templates folder, so that when you create new templates, they are saved to that location, and thus are available for selection when creating new documents.  The steps to find the Templates folder path are …
This article helps those who get the 0xc004d307 error when trying to rearm (reset the license) Office 2013 in a Virtual Desktop Infrastructure (VDI) and/or those trying to prep the master image for Microsoft Key Management (KMS) activation. (i.e.- C…
This Micro Tutorial demonstrates using Microsoft Excel pivot tables, how to reverse engineer competitors' marketing strategies through backlinks.
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.

622 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question