Loops through Sheets but doesn't work.

H

Homer

I am trying to loop through all sheets and place borders in the sheets. I
assume it is looping through the sheets becuse my screen flickers, but the
borders are not put on the sheets.

What do I have wrong?


Sub Set_Borders()
Dim sht As Worksheet
For Each sht In ActiveWorkbook.Sheets
Range("A1:AG53").Select
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
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
Range("A1:AG1").Select
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 = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
Next sht
Sheets("All").Activate
End Sub
 
J

Jim Thomlinson

Your sheet object is looping through the sheets but your code is only acting
on the active sheet... Your code can also be tightened up a bit... (I think
that's correct)

Sub Set_Borders()
Dim sht As Worksheet
For Each sht In ActiveWorkbook.Sheets
with sht.Range("A1:AG53")
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
.Borders.LineStyle = xlContinuous
.Borders.Weight = xlMedium
.Borders.ColorIndex = xlAutomatic
.Borders(xlInsideVertical).Weight = xlHairline
.Borders(xlInsideHorizontal).Weight = xlHairline
End With
With sht.Range("A1:AG1")
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
.Borders.LineStyle = xlContinuous
.Borders.Weight = xlMedium
.Borders.ColorIndex = xlAutomatic
.Borders(xlInsideVertical).Weight = xlHairline
.Borders(xlInsideHorizontal).Weight = xlHairline
End With
Next sht
Sheets("All").Activate
End Sub
 
J

Joel

Sub Set_Borders()
Dim sht As Worksheet
For Each sht In ActiveWorkbook.Sheets
With sht
With .Range("A1:AG53")
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
End With

With Range("A1:AG1")
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
End With
End With
Next sht
End Sub
 
H

Homer

I see now where the problem is. And yes, the tightening works well. Thanks
for the quick help.

This will also solve another issue I was having as well.

Thanks,

Don
 
J

Joel

I left a period off of one line

from
With Range("A1:AG1")
to
With .Range("A1:AG1")

Because your two Ranges overlap the 2nd range was duplicating a lot of the
same settings as the 1st range. here is simplified code

Sub Set_Borders()
Dim sht As Worksheet
For Each sht In ActiveWorkbook.Sheets
With sht
With .Range("A1:AG53")
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
End With

With .Range("A1:AG1")
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End With
End With
Next sht
End Sub
 
J

Joel

Because your areas overlap and Jim didn't catch all the minor differences
here is the implimentation the way your code was originally was written

Sub Set_Borders()
Dim sht As Worksheet
For Each sht In ActiveWorkbook.Sheets
with sht.Range("A1:AG53")
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
.Borders.LineStyle = xlContinuous
.Borders.Weight = xlMedium
.Borders.ColorIndex = xlAutomatic
.Borders(xlInsideVertical).Weight = xlHairline
.Borders(xlInsideHorizontal).Weight = xlHairline
End With
With sht.Range("A1:AG1")
With .Borders(xlEdgeBottom)
.Weight = xlThin
End With
End With
Next sht
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Formatting stop when reach blank cell 6
Help with macro 1
Hlp! Adv Filter - Non-Contiguous rows don't copy 11
AutoFilter 7
Format cell and adjacent cell 3
problem with code 3
How to rewrite this code? (Second half) 1
Borders Object 3

Top