Loops through Sheets but doesn't work.

  • Thread starter Thread starter Homer
  • Start date Start date
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
 
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
 
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
 
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
 
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
 
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
 
Back
Top