Automatically bordering in 1500 sheets

[hardeep via OfficeKB.com]

Hi! Everybody

I have a workbook with 1500 sheets with same Columns i.e A to M .But the row
range is Different some sheets has Range A1 to M2, Some has A1 to M50 and
Some has A1 to M20 and so on.

Now i want to Bordering the all sheets. Firstly apply the ALL BORDER and then
THICK BOX BORDER in all sheets. Is it possible? Because i dont want to do
manually one by one.


Any Solution will Be most Appriciate

Thanks In Advance

Hardeep kanwar

 

[Gary Keramidas]

maybe you can adapt this:

Sub test()
Dim lastcol As Long
Dim RealLastRow As Long
Dim ws As Worksheets
Dim arr As Variant
Dim i As Long, z As Long
For z = 1 To Worksheets.Count
With Worksheets(z)
lastcol = .Cells(1, Columns.Count).End(xlToLeft).Column
ReDim arr(1 To lastcol)

For i = 1 To lastcol
arr(i) = .Cells(Rows.Count, i).End(xlUp).Row
Next
RealLastRow = Application.Max(arr)
.Range("A1:" & .Cells(RealLastRow, _
lastcol).Address).BorderAround ColorIndex:=3,
Weight:=xlThick
End With
Next
End Sub

 

[Ranjit kurian]

Hi Hardeep

Try the below code,

Sub Boarding()
Dim sh
For sh = 1 To Sheets.Count
Sheets(sh).Select
Range("A1").Select
Range("A65536").End(xlUp).Select
Range(Selection, Selection.End(xlUp)).Select
Range(Selection, Selection.End(xlToRight)).Select

'board
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
Range("A1").Select
Next sh
End Sub

 

[Hardeep_kanwar]

Thanks Sir

It works Fine But not Completely. As I mentioned that First apply the ALL
BORDERS and then THICK BOX BORDERS

Your Code apply only THICK BOX BORDERS for outer edge ,But not apply ALL
BORDERS. Which is apply on inner data.


Thanks For your Quick Reply

Regards

Hardeep kanwar

 

[hardeep via OfficeKB.com]

Dear Sir

Thanks For Your Code

But unfortunataly it does't work when i ran the macro it show the ERROR
MASSAGE

COMPILE ERRROR: SYNTAX ERROR

I am totally stupid in Macros. I knew only how to create and run the macros

Thanks

hardeep kanwar

maybe you can adapt this:

Sub test()
Dim lastcol As Long
Dim RealLastRow As Long
Dim ws As Worksheets
Dim arr As Variant
Dim i As Long, z As Long
For z = 1 To Worksheets.Count
With Worksheets(z)
lastcol = .Cells(1, Columns.Count).End(xlToLeft).Column
ReDim arr(1 To lastcol)

For i = 1 To lastcol
arr(i) = .Cells(Rows.Count, i).End(xlUp).Row
Next
RealLastRow = Application.Max(arr)
.Range("A1:" & .Cells(RealLastRow, _
lastcol).Address).BorderAround ColorIndex:=3,
Weight:=xlThick
End With
Next
End Sub

Hi! Everybody

[quoted text clipped - 11 lines]

Hardeep kanwar

 

[Ranjit kurian]

Hi Hardeep,

I have changed my code, try it and let me know, if anything else required

Sub Boarding()
Dim sh
For sh = 1 To Sheets.Count
Sheets(sh).Select
Range("A1").Select
Range("A65536").End(xlUp).Select
Range(Selection, Selection.End(xlUp)).Select
Range(Selection, Selection.End(xlToRight)).Select

'board
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
Range("A1").Select
Next sh

End Sub

 

[Don Guillett]

try this
Sub doborders()
For Each ws In ActiveWorkbook.Worksheets
lr = ws.Cells.SpecialCells(xlCellTypeLastCell).Row
With ws.Range("a1:m" & lr) 'Selection
.Borders.LineStyle = xlContinuous
.BorderAround Weight:=xlThick 'Medium
End With
Next ws
End Sub

 

[hardeep via OfficeKB.com]

Greeeeeeeeeeeeeeeeeeeeeeeeeeeeet

Most Appriciate

Thank sir

Hardeep kanwar

try this
Sub doborders()
For Each ws In ActiveWorkbook.Worksheets
lr = ws.Cells.SpecialCells(xlCellTypeLastCell).Row
With ws.Range("a1:m" & lr) 'Selection
.Borders.LineStyle = xlContinuous
.BorderAround Weight:=xlThick 'Medium
End With
Next ws
End Sub

Hi! Everybody

[quoted text clipped - 13 lines]

Hardeep kanwar

 

[hardeep via OfficeKB.com]

Its Work Great

Thanks For your Quickly Reply

thanks for solving my problem

Thank again

hardeep kanwar

Hi Hardeep,

I have changed my code, try it and let me know, if anything else required

Sub Boarding()
Dim sh
For sh = 1 To Sheets.Count
Sheets(sh).Select
Range("A1").Select
Range("A65536").End(xlUp).Select
Range(Selection, Selection.End(xlUp)).Select
Range(Selection, Selection.End(xlToRight)).Select

'board
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
Range("A1").Select
Next sh

End Sub

Thanks Sir

[quoted text clipped - 65 lines]

 

[Don Guillett]

It could be even better and adaptable to a change to fewer rows IF we knew
which column is always the one with the last value. Then it could delete
too.
--
Don Guillett
Microsoft MVP Excel
SalesAid Software
(e-mail address removed)

Greeeeeeeeeeeeeeeeeeeeeeeeeeeeet

Most Appriciate

Thank sir

Hardeep kanwar

try this
Sub doborders()
For Each ws In ActiveWorkbook.Worksheets
lr = ws.Cells.SpecialCells(xlCellTypeLastCell).Row
With ws.Range("a1:m" & lr) 'Selection
.Borders.LineStyle = xlContinuous
.BorderAround Weight:=xlThick 'Medium
End With
Next ws
End Sub

Hi! Everybody

[quoted text clipped - 13 lines]

Hardeep kanwar

 

[Gary Keramidas]

that's basically the route i took in my code, but it wrapped and the op couldn't
figure out how to make i compile.

--


Gary

It could be even better and adaptable to a change to fewer rows IF we knew
which column is always the one with the last value. Then it could delete too.
--
Don Guillett
Microsoft MVP Excel
SalesAid Software
(e-mail address removed)

Greeeeeeeeeeeeeeeeeeeeeeeeeeeeet

Most Appriciate

Thank sir

Hardeep kanwar

try this
Sub doborders()
For Each ws In ActiveWorkbook.Worksheets
lr = ws.Cells.SpecialCells(xlCellTypeLastCell).Row
With ws.Range("a1:m" & lr) 'Selection
.Borders.LineStyle = xlContinuous
.BorderAround Weight:=xlThick 'Medium
End With
Next ws
End Sub

Hi! Everybody

[quoted text clipped - 13 lines]

Hardeep kanwar

 

[Tom Ogilvy]

I have a workbook with 1500 sheets with same Columns i.e A to M

I thought he said it was always A to M

--
Regards,
Tom Ogilvy

that's basically the route i took in my code, but it wrapped and the op couldn't
figure out how to make i compile.

--


Gary

It could be even better and adaptable to a change to fewer rows IF we knew
which column is always the one with the last value. Then it could delete too.
--
Don Guillett
Microsoft MVP Excel
SalesAid Software
(e-mail address removed)

Greeeeeeeeeeeeeeeeeeeeeeeeeeeeet

Most Appriciate

Thank sir

Hardeep kanwar


Don Guillett wrote:
try this
Sub doborders()
For Each ws In ActiveWorkbook.Worksheets
lr = ws.Cells.SpecialCells(xlCellTypeLastCell).Row
With ws.Range("a1:m" & lr) 'Selection
.Borders.LineStyle = xlContinuous
.BorderAround Weight:=xlThick 'Medium
End With
Next ws
End Sub

Hi! Everybody

[quoted text clipped - 13 lines]

Hardeep kanwar

 

[Don Guillett]

Sub doborders1() 'assumes A is ALWAYS the longest column
For Each ws In ActiveWorkbook.Worksheets
ws.Cells.Borders.LineStyle = xlNone
lr = ws.Cells(Rows.Count, "a").End(xlUp).Row
With ws.Range("a1:m" & lr)
.Borders.LineStyle = xlContinuous
.BorderAround Weight:=xlThick 'Medium
End With
Next ws
End Sub


--
Don Guillett
Microsoft MVP Excel
SalesAid Software
(e-mail address removed)

that's basically the route i took in my code, but it wrapped and the op
couldn't figure out how to make i compile.

--


Gary

It could be even better and adaptable to a change to fewer rows IF we
knew which column is always the one with the last value. Then it could
delete too.
--
Don Guillett
Microsoft MVP Excel
SalesAid Software
(e-mail address removed)

Greeeeeeeeeeeeeeeeeeeeeeeeeeeeet

Most Appriciate

Thank sir

Hardeep kanwar


Don Guillett wrote:
try this
Sub doborders()
For Each ws In ActiveWorkbook.Worksheets
lr = ws.Cells.SpecialCells(xlCellTypeLastCell).Row
With ws.Range("a1:m" & lr) 'Selection
.Borders.LineStyle = xlContinuous
.BorderAround Weight:=xlThick 'Medium
End With
Next ws
End Sub

Hi! Everybody

[quoted text clipped - 13 lines]

Hardeep kanwar

 

[Gary Keramidas]

but i wasn't sure which column had data in the highest row number.. it may have
been M, but i wasn't sure.

--


Gary

I have a workbook with 1500 sheets with same Columns i.e A to M

I thought he said it was always A to M

--
Regards,
Tom Ogilvy

that's basically the route i took in my code, but it wrapped and the op
couldn't
figure out how to make i compile.

--


Gary

It could be even better and adaptable to a change to fewer rows IF we knew
which column is always the one with the last value. Then it could delete
too.
--
Don Guillett
Microsoft MVP Excel
SalesAid Software
(e-mail address removed)
Greeeeeeeeeeeeeeeeeeeeeeeeeeeeet

Most Appriciate

Thank sir

Hardeep kanwar


Don Guillett wrote:
try this
Sub doborders()
For Each ws In ActiveWorkbook.Worksheets
lr = ws.Cells.SpecialCells(xlCellTypeLastCell).Row
With ws.Range("a1:m" & lr) 'Selection
.Borders.LineStyle = xlContinuous
.BorderAround Weight:=xlThick 'Medium
End With
Next ws
End Sub

Hi! Everybody

[quoted text clipped - 13 lines]

Hardeep kanwar