-
Dec 7th, 2017, 11:24 AM
#1
Thread Starter
Hyperactive Member
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
-
Dec 8th, 2017, 03:50 AM
#2
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
-
Dec 8th, 2017, 04:09 AM
#3
Thread Starter
Hyperactive Member
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.
-
Dec 8th, 2017, 05:03 AM
#4
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
-
Dec 8th, 2017, 05:09 AM
#5
Thread Starter
Hyperactive Member
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
-
Dec 12th, 2017, 06:05 AM
#6
Thread Starter
Hyperactive Member
Re: Border around a range of columns after each change in column A
can anyone help with this please?
-
Dec 12th, 2017, 09:39 AM
#7
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
-
Dec 12th, 2017, 10:25 AM
#8
Thread Starter
Hyperactive Member
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.
-
Dec 12th, 2017, 12:51 PM
#9
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?
-
Dec 12th, 2017, 03:06 PM
#10
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
-
Dec 13th, 2017, 04:19 AM
#11
Thread Starter
Hyperactive Member
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.
-
Dec 13th, 2017, 04:41 AM
#12
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.
-
Dec 13th, 2017, 04:49 AM
#13
Thread Starter
Hyperactive Member
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.
-
Dec 13th, 2017, 04:58 AM
#14
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
-
Dec 13th, 2017, 05:15 AM
#15
Thread Starter
Hyperactive Member
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
-
Dec 13th, 2017, 05:42 AM
#16
Re: Border around a range of columns after each change in column A
Does each sheet have multiple departments, or just one?
-
Dec 13th, 2017, 05:57 AM
#17
Thread Starter
Hyperactive Member
Re: Border around a range of columns after each change in column A
Originally Posted by vbfbryce
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?
-
Dec 13th, 2017, 08:27 AM
#18
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
-
Dec 13th, 2017, 11:20 AM
#19
Thread Starter
Hyperactive Member
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.
-
Dec 13th, 2017, 11:22 AM
#20
Re: Border around a range of columns after each change in column A
can you zip and attach a workbook, with your current code?
-
Dec 14th, 2017, 09:34 AM
#21
Thread Starter
Hyperactive Member
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.
-
Dec 16th, 2017, 08:18 AM
#22
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.
-
Dec 16th, 2017, 08:53 PM
#23
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...
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
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|