Results 1 to 23 of 23

Thread: Border around a range of columns after each change in column A

  1. #1

    Thread Starter
    Hyperactive Member
    Join Date
    Jul 2014
    Posts
    367

    Border around a range of columns after each change in column A

    Hi I have data from columns A to J. In Column A there is the department code and from columns B to J there is data for that department. There number of rows for each department code varies.
    I would like to add a solid border around the column at each change in column A - the department code. Can anyone help with the code for this please. Thanks

  2. #2
    PowerPoster
    Join Date
    Dec 2004
    Posts
    25,618

    Re: Border around a range of columns after each change in column A

    you can test this to see if it works as desired
    Code:
    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Range("a2").Resize(Cells(Rows.Count, 1).End(xlUp).Row)) Is Nothing Then
         With Range("b1:j1")
            .Resize(Me.UsedRange.Rows.Count - 1).Borders.LineStyle = xlLineStyleNone
            Set dept = .Find(Target)
            If Not dept Is Nothing Then
                With dept.Resize(Cells(Rows.Count, dept.Column).End(xlUp).Row)
                    .Borders(xlEdgeLeft).LineStyle = xlDouble
                    .Borders(xlEdgeRight).LineStyle = xlDouble
                    .Cells(1).Borders(xlEdgeTop).LineStyle = xlDouble
                    .Cells(.Cells.Count).Borders(xlEdgeBottom).LineStyle = xlDouble              
                End With
            End If
         End With
    End If
    End Sub
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

  3. #3

    Thread Starter
    Hyperactive Member
    Join Date
    Jul 2014
    Posts
    367

    Re: Border around a range of columns after each change in column A

    Thanks for the code. Forgot to mention that there will be multiple sheets that I'll need to apply the borders to.
    I have another part of the code which splits the master worksheet into multiple sheets at each change in column A.

  4. #4
    PowerPoster
    Join Date
    Dec 2004
    Posts
    25,618

    Re: Border around a range of columns after each change in column A

    you should be able to adapt the code to work with multiple sheets, i have no idea how your sheets are set up, so can not convert for you
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

  5. #5

    Thread Starter
    Hyperactive Member
    Join Date
    Jul 2014
    Posts
    367

    Re: Border around a range of columns after each change in column A

    Here is the full code which splits sheets and a few other things
    Code:
    Sub splitsheets()
        Dim wb As Workbook
        Dim wsMain As Worksheet
        Dim wsNew As Worksheet
        Dim j As Integer
        Dim x As Integer
        Dim lr As Integer
        Dim lp As Integer
        Dim dataEnd As Long
        Dim prod As String
        Dim rngHeader As Range
        Dim mypict As Object
        
        
        
        Set ws = ActiveSheet
        With ws
            lastRow = .Range("k" & Rows.Count).End(xlUp).Row
            For x = 2 To lastRow 'or 2 if headers
                If .Range("h" & x).Value = "" Then
                    .Range("i" & x & ":k" & x).Interior.Color = vbYellow
                    .Range("i" & x & ":k" & x).Font.Bold = True
                    .Range("i" & x & ":k" & x).HorizontalAlignment = xlRight
                End If
            Next x
        End With
          
        
        
        
        
        Set wb = ActiveWorkbook
        Set wsMain = wb.Worksheets(1)
        Set rngHeader = wsMain.Range("a1:l1") 'change depending on how many columns
        lr = wsMain.Range("j" & Rows.Count).End(xlUp).Row   'last row of data in j
        lp = wsMain.Range("b" & Rows.Count).End(xlUp).Row   'last row with a product
        prod = wsMain.Range("a2").Value
        With wsMain
            dataEnd = .Range("a2").End(xlDown).Row - 1
            Set wsNew = wb.Worksheets.Add(after:=wsMain)
            .Range("a2:l" & dataEnd).Copy
            wsNew.Range("a2").PasteSpecial
           wsNew.Range("a:l").Columns.AutoFit
            wsNew.Range("a1:l1").Font.Bold = True
            rngHeader.Copy
            wsNew.Range("a1").PasteSpecial
            wsNew.Range("a:l").Columns.AutoFit
            wsNew.Range("a1:l1").Font.Bold = True
            Application.CutCopyMode = False
                    Columns("I:k").Select
           Selection.NumberFormat = "0.00"
           
           
                 Range("A1").Select
                
                        
            wsNew.Rows("1:4").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
             
               With wsNew.Range("a1")
                Set mypict = .Parent.Pictures.Insert("c:\logo.gif")
                mypict.Top = .Top
                mypict.Left = .Left
                mypict.Placement = xlMoveAndSize
                mypict.ShapeRange.ScaleHeight 0.8823058409, msoFalse, msoScaleFromTopLeft
                
           End With
                
                
        
           
           
           
           
           
    
                   
            wsNew.Name = prod
            For j = dataEnd + 1 To lp
                prod = .Range("a" & j).Value
                If j = lp Then
                    dataEnd = lr
                Else
                    dataEnd = .Range("a" & j).End(xlDown).Row - 1
                End If
                Set wsNew = wb.Worksheets.Add(after:=wb.Worksheets(wb.Worksheets.Count))
                .Range("a" & j & ":l" & dataEnd).Copy
                wsNew.Range("a2").PasteSpecial
                wsNew.Range("a:l").Columns.AutoFit
               wsNew.Range("a1:l1").Font.Bold = True
                rngHeader.Copy
               wsNew.Range("a1").PasteSpecial
                wsNew.Range("a:l").Columns.AutoFit
                wsNew.Range("a1:l1").Font.Bold = True
              Application.CutCopyMode = False
                               Columns("I:k").Select
            Selection.NumberFormat = "0.00"
            
    
    
         
            
            
              
            
            
             Range("A1").Select
                
                        
            wsNew.Rows("1:4").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
             
               With wsNew.Range("a1")
                Set mypict = .Parent.Pictures.Insert("C:\logo.gif")
                mypict.Top = .Top
                mypict.Left = .Left
                mypict.Placement = xlMoveAndSize
                mypict.ShapeRange.ScaleHeight 0.8823058409, msoFalse, msoScaleFromTopLeft
                
                End With
                          
                      wsNew.Name = prod
                j = dataEnd
            Next j
        End With
        
       End Sub

  6. #6

    Thread Starter
    Hyperactive Member
    Join Date
    Jul 2014
    Posts
    367

    Re: Border around a range of columns after each change in column A

    can anyone help with this please?

  7. #7
    PowerPoster
    Join Date
    Oct 2008
    Location
    Midwest Region, United States
    Posts
    3,574

    Re: Border around a range of columns after each change in column A

    Try something like this to put borders around each department's data on each sheet (although you may want to sub in Pete's code within the sheet loops, it's probably more efficient):

    Code:
    Sub addBorders()
        Dim wb As Workbook
        Dim ws As Worksheet
        Dim j As Integer
        Dim k As Integer
        Dim deptFirst As Integer
        Dim deptLast As Integer
        Dim lastRow As Integer
        
        Set wb = ActiveWorkbook
        With wb
            For j = 1 To wb.Worksheets.Count
            
                Set ws = wb.Worksheets(j)
                With ws
                    deptLast = 2
                    lastRow = .Range("a" & Rows.Count).End(xlUp).Row
                    For k = 2 To lastRow
                        If k = lastRow Then
                            'if only one record for last department
                            With .Range("a" & k & ":j" & k)
                                .Borders(xlEdgeLeft).LineStyle = xlDouble
                                .Borders(xlEdgeRight).LineStyle = xlDouble
                                .Borders(xlEdgeTop).LineStyle = xlDouble
                                .Borders(xlEdgeBottom).LineStyle = xlDouble
                            End With
                            deptLast = k
                        Else
                            deptFirst = k
                            deptLast = k
                            While .Range("a" & deptLast).Value = .Range("a" & deptFirst).Value
                                deptLast = deptLast + 1
                            Wend
                            deptLast = deptLast - 1
                            
                            With .Range("a" & deptFirst & ":j" & deptLast)
                                .Borders(xlEdgeLeft).LineStyle = xlDouble
                                .Borders(xlEdgeRight).LineStyle = xlDouble
                                .Borders(xlEdgeTop).LineStyle = xlDouble
                                .Borders(xlEdgeBottom).LineStyle = xlDouble
                            End With
                        End If
                        k = deptLast
                    Next k
                End With
            Next j
        End With
    End Sub

  8. #8

    Thread Starter
    Hyperactive Member
    Join Date
    Jul 2014
    Posts
    367

    Re: Border around a range of columns after each change in column A

    I'm not sure how to incorporate this into the main code. Any help with this would be really appreciated.

  9. #9
    PowerPoster
    Join Date
    Oct 2008
    Location
    Midwest Region, United States
    Posts
    3,574

    Re: Border around a range of columns after each change in column A

    Can you describe the steps you're needing to accomplish in simple terms?

  10. #10
    PowerPoster
    Join Date
    Dec 2004
    Posts
    25,618

    Re: Border around a range of columns after each change in column A

    post a sample workbook, with before and after data and explain what the desired results are

    there was no mention in the original post about having the borders selection with other code or multiple sheets, i though i had understood what you wanted to achieve, so i used the selection change event to move the borders, whenever a cell in column A was selected, i have no clear understanding at all of what you want now, i doubt that bryce has any more idea about your desired results

    why do the codes have to be incorporated together?
    split the data first, then move the borders when some cell is selected
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

  11. #11

    Thread Starter
    Hyperactive Member
    Join Date
    Jul 2014
    Posts
    367

    Re: Border around a range of columns after each change in column A

    Hi...the only reason I wanted to incorporate the codes together is so that the "whole job" is done in one go rather than run each part of the code separately.

    In the original post I didn't mention anything about the borders as there was no plan to have them but to make the presentation look better I decided to add the border.

    The code I posted above is perfect up to the point of splitting the sheets.

  12. #12
    PowerPoster
    Join Date
    Oct 2008
    Location
    Midwest Region, United States
    Posts
    3,574

    Re: Border around a range of columns after each change in column A

    I'm still not clear. Are you okay with what your full code is currently doing, and just want to add in the code I posted? Or does it need to operate in a different sequence? If you just need to have my code run when the other is done, add it as a separate sub in the same module, and call it at the end of your code. If something else, explain further.

  13. #13

    Thread Starter
    Hyperactive Member
    Join Date
    Jul 2014
    Posts
    367

    Re: Border around a range of columns after each change in column A

    Hi...the full code I have is fine. It works perfectly. All I want to add to the code is your part of the code so everything runs in one job rather than running one script at a time.
    From rows 1 to 4 will be the logo and the column headings start from A5.
    Thanks for your help with this.

  14. #14
    PowerPoster
    Join Date
    Oct 2008
    Location
    Midwest Region, United States
    Posts
    3,574

    Re: Border around a range of columns after each change in column A

    So change my code to start at row 6 instead of row 2, then do something like this?

    Code:
    Sub yourCode()
        'do a bunch of things
        'do a bunch of things
        'do a bunch of things
        'do a bunch of things
        'do a bunch of things
        
        Call myCode
        
    End Sub
    
    Sub myCode()
        'put borders on each worksheet
    End Sub

  15. #15

    Thread Starter
    Hyperactive Member
    Join Date
    Jul 2014
    Posts
    367

    Re: Border around a range of columns after each change in column A

    Thanks for that. That's great. I completely forgot about Call mycode.
    your code for the borders is only adding the border to one row. Some sheets may have 5 rows and some may have 50. Which part of the code do I need to change?
    Code:
    Sub addBorders()
        Dim wb As Workbook
        Dim ws As Worksheet
        Dim j As Integer
        Dim k As Integer
        Dim deptFirst As Integer
        Dim deptLast As Integer
        Dim lastRow As Integer
        
        Set wb = ActiveWorkbook
        With wb
            For j = 1 To wb.Worksheets.Count
            
                Set ws = wb.Worksheets(j)
                With ws
                    deptLast = 6
                    lastRow = .Range("a" & Rows.Count).End(xlUp).Row
                    For l = 6 To lastRow
                        If l = lastRow Then
                            'if only one record for last department
                            With .Range("a" & l & ":l" & l)
                                .Borders(xlEdgeLeft).LineStyle = xlDouble
                                .Borders(xlEdgeRight).LineStyle = xlDouble
                                .Borders(xlEdgeTop).LineStyle = xlDouble
                                .Borders(xlEdgeBottom).LineStyle = xlDouble
                            End With
                            deptLast = l
                        Else
                            deptFirst = l
                            deptLast = l
                            While .Range("a" & deptLast).Value = .Range("a" & deptFirst).Value
                                deptLast = deptLast + 1
                            Wend
                            deptLast = deptLast - 1
                            
                            With .Range("a" & deptFirst & ":j" & deptLast)
                                .Borders(xlEdgeLeft).LineStyle = xlDouble
                                .Borders(xlEdgeRight).LineStyle = xlDouble
                                .Borders(xlEdgeTop).LineStyle = xlDouble
                                .Borders(xlEdgeBottom).LineStyle = xlDouble
                            End With
                        End If
                        l = deptLast
                    Next l
                End With
            Next j
        End With
    End Sub

  16. #16
    PowerPoster
    Join Date
    Oct 2008
    Location
    Midwest Region, United States
    Posts
    3,574

    Re: Border around a range of columns after each change in column A

    Does each sheet have multiple departments, or just one?

  17. #17

    Thread Starter
    Hyperactive Member
    Join Date
    Jul 2014
    Posts
    367

    Re: Border around a range of columns after each change in column A

    Quote Originally Posted by vbfbryce View Post
    Does each sheet have multiple departments, or just one?
    Each sheet after the split will have just one department but there will be sub-totals at each change on column C. So it would be really good if a thick border can be applied at each sub-total?

  18. #18
    PowerPoster
    Join Date
    Oct 2008
    Location
    Midwest Region, United States
    Posts
    3,574

    Re: Border around a range of columns after each change in column A

    Ok, change my code in post #7 to look at column C instead of column A.

    Like:

    Code:
    While .Range("a" & deptLast).Value = .Range("a" & deptFirst).Value
    change to:

    Code:
    While .Range("c" & deptLast).Value = .Range("c" & deptFirst).Value

  19. #19

    Thread Starter
    Hyperactive Member
    Join Date
    Jul 2014
    Posts
    367

    Re: Border around a range of columns after each change in column A

    Thanks for that. This is inserting a border around all the columns in row 6 only and also columns A to J and rows 2 to 5.

  20. #20
    PowerPoster
    Join Date
    Oct 2008
    Location
    Midwest Region, United States
    Posts
    3,574

    Re: Border around a range of columns after each change in column A

    can you zip and attach a workbook, with your current code?

  21. #21

    Thread Starter
    Hyperactive Member
    Join Date
    Jul 2014
    Posts
    367

    Re: Border around a range of columns after each change in column A

    I've been playing around with this part of the code
    Code:
    Sub addBorders()
        Dim wb As Workbook
        Dim ws As Worksheet
        Dim j As Integer
        Dim k As Integer
        Dim deptFirst As Integer
        Dim deptLast As Integer
        Dim lastRow As Integer
        
        Set wb = ActiveWorkbook
        With wb
            For j = 1 To wb.Worksheets.Count
            
                Set ws = wb.Worksheets(j)
                With ws
                    deptLast = 6
                    lastRow = .Range("c" & Rows.Count).End(xlUp).Row
                    For k = 6 To lastRow
                        If k = lastRow Then
                            'if only one record for last department
                            With .Range("a" & k & ":l" & k)
                                .Borders(xlEdgeLeft).LineStyle = xlDouble
                                .Borders(xlEdgeRight).LineStyle = xlDouble
                                .Borders(xlEdgeTop).LineStyle = xlDouble
                                .Borders(xlEdgeBottom).LineStyle = xlDouble
                            End With
                            deptLast = k
                        Else
                            deptFirst = k
                            deptLast = k
                            While .Range("c" & deptLast).Value = .Range("c" & deptFirst).Value
                                deptLast = deptLast + 1
                            Wend
                            deptLast = deptLast - 1
                            
                            With .Range("a" & deptFirst & ":l" & deptLast)
                                .Borders(xlEdgeLeft).LineStyle = xlDouble
                                .Borders(xlEdgeRight).LineStyle = xlDouble
                                .Borders(xlEdgeTop).LineStyle = xlDouble
                                .Borders(xlEdgeBottom).LineStyle = xlDouble
                            End With
                        End If
                        k = deptLast
                    Next k
                End With
            Next j
        End With
    End Sub
    It does now add a border at each change in column C but I really want the border to insert up to the total lines which are in columns I, J and K rather than just the first line with the change in column C.

  22. #22
    PowerPoster
    Join Date
    Oct 2008
    Location
    Midwest Region, United States
    Posts
    3,574

    Re: Border around a range of columns after each change in column A

    Please zip and attach a workbook so we can see what it's doing, thanks.

  23. #23
    Don't Panic! Ecniv's Avatar
    Join Date
    Nov 2000
    Location
    Amsterdam...
    Posts
    5,343

    Re: Border around a range of columns after each change in column A

    Code:
        Const colWithData = 1
        Const colDept = 1
    
        Dim wrk As Workbook
        Dim sht As Worksheet
        Dim rng As Range
        
        Dim lngDataRow As Long
        Dim lngMaxRow As Long
        Dim lngMaxCol As Long
        Dim lngCurRow As Long
        
        Dim strCurDept As String
        Dim lngStartDept As Long
        
        Set wrk = ActiveWorkbook
        
        For Each sht In wrk.Sheets
            If (sht.Cells(1, colWithData) = "") Then
                lngDataRow = sht.Cells(1, colWithData).End(xlDown).Row + 1
            Else
                lngDataRow = 2
            End If
            lngMaxRow = sht.Cells(65535, colWithData).End(xlUp).Row
            lngMaxCol = sht.Cells(lngDataRow - 1, colWithData).End(xlToRight).Column
            'Debug.Print sht.Name, lngDataRow, lngMaxRow, lngMaxCol
            strCurDept = ""
            lngStartDept = 0
            For lngCurRow = lngDataRow To lngMaxRow
                If (strCurDept <> CStr(sht.Cells(lngCurRow, colDept))) Then
                    If lngStartDept > 0 Then
                        Set rng = sht.Range(sht.Cells(lngStartDept, 1), sht.Cells(lngCurRow - 1, lngMaxCol))
                        rng.Borders(xlEdgeLeft).LineStyle = xlDouble
                        rng.Borders(xlEdgeRight).LineStyle = xlDouble
                        rng.Borders(xlEdgeTop).LineStyle = xlDouble
                        rng.Borders(xlEdgeBottom).LineStyle = xlDouble
                    End If
                    lngStartDept = lngCurRow
                    strCurDept = CStr(sht.Cells(lngCurRow, colDept))
                End If
            Next
            ' catch the last dept
            Set rng = sht.Range(sht.Cells(lngStartDept, 1), sht.Cells(lngCurRow - 1, lngMaxCol))
            rng.Borders(xlEdgeLeft).LineStyle = xlDouble
            rng.Borders(xlEdgeRight).LineStyle = xlDouble
            rng.Borders(xlEdgeTop).LineStyle = xlDouble
            rng.Borders(xlEdgeBottom).LineStyle = xlDouble
            
        Next
        
    
        
        Set wrk = Nothing
    Admittedly I havent read all the posts...

    BOFH Now, BOFH Past, Information on duplicates

    Feeling like a fly on the inside of a closed window (Thunk!)
    If I post a lot, it is because I am bored at work! ;D Or stuck...
    * Anything I post can be only my opinion. Advice etc is up to you to persue...

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width