Change alignment based upon cell value & loop thru mutliple worksheets

NoviceLois

New Member
Joined
Nov 22, 2019
Messages
12
Office Version
  1. 2016
Platform
  1. Windows
I am new to VBA and programming in general. I am trying to right align all the values in cells, unless they contain "R", then I want the "R" center aligned, bolded and in red. On each worksheet in the workbook. Thru the generosity of others I was able to find code to eliminate worksheets I do not want changed, and to right align. I used a macro to get the code for conditional formatting to make the "R" bolded Red. But to center align just the cells with the "R" has yielded nothing but compile errors. Thank you in advance for your kind assistance.

Here is the code so far.

Code:
Option Explicit
Sub rgtalgnredRctr()
Dim rs As Worksheet
Dim Cell As Range
For Each rs In ThisWorkbook.Worksheets
If rs.Name <> "Data" And rs.Name <> "Tools" Then
Range("E4").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
With Selection '
' Rightjustify Macro
'
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
End If

Range("E2").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="=""R"""
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
.Color = -16777024
.TintAndShade = 0

End With

Range("E2").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
For Each Cell In Selection
If Cell.Value = "R" Then
Cell.HorizontalAlignment = xlCenter
End If

Next Cell

End Sub
 
Last edited by a moderator:

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
Try
Code:
Cell.HorizontalAlignment = xlHAlignCenter
 
Upvote 0
Thank you for your reply JLGWhiz.

I used xlHAlignCenter, but am still getting a "Compile Error: For Without Next " with the highlighted final End Sub.
 
Upvote 0
You do not have a Next for your worksheet loop. Add another Next after 'Next Cell'
Code:
             Cell.HorizontalAlignment = xlCenter
         End If
     Next Cell
Next
End Sub
 
Upvote 0
Thank you for the assistance. I added the "Next" after the "Next Cell", but now I am getting another compile error, "Next without For". Ideas?
 
Upvote 0
You shouldn't get that error if you added it where JLGWhiz showed.
Can you post the code you are now using. When posting code please use code tags How to Post Your VBA Code
 
Upvote 0
Here is a screen shot of the Compile error, if that helps.
VBA Code:
Sub RightjustifyBoldRedCtralgn()

'
            Range("E2").Select
            Range(Selection, Selection.End(xlDown)).Select
            Range(Selection, Selection.End(xlToRight)).Select
            With Selection '
' Rightjustify Macro
'
    
            .HorizontalAlignment = xlRight
            .VerticalAlignment = xlBottom
            .WrapText = True
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
        End With
        With Selection
            .HorizontalAlignment = xlGeneral
            .VerticalAlignment = xlBottom
            .WrapText = True
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
        End With
        With Selection
            .HorizontalAlignment = xlRight
            .VerticalAlignment = xlBottom
            .WrapText = True
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
    End With
    ActiveWindow.SmallScroll Down:=-78
'

            Range("E2").Select
            Range(Selection, Selection.End(xlDown)).Select
            Range(Selection, Selection.End(xlToRight)).Select
            Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
                Formula1:="=""R"""
            Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
            With Selection.FormatConditions(1).Font
                .Bold = True
                .Italic = False
                .Color = -16777024
                .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False


             For Each Cell In Selection
             If Cell.Value = "R" Then
            Cell.HorizontalAlignment = xlCenter
        End If
        
    Next Cell
    
 Next

 End Sub

1574546020800.png
 
Upvote 0
See if this version works any better for you.

Code:
Sub rgtalgnredRctr()
Dim rs As Worksheet, c As Range, lc As Long, lr As Long
    For Each rs In ThisWorkbook.Worksheets
        lc = rs.Cells.Find("*", , xlFormulas, xlPart, xlByColumns, xlPrevious).Column
        lr = rs.Cells.Find("*", , xlFormulas, xlPart, xlByRows, xlPrevious).Row
        If rs.Name <> "Data" And rs.Name <> "Tools" Then
            With rs.Range("E4", rs.Cells(lr, lc))
            ' Rightjustify Macro
                .HorizontalAlignment = xlRight
                .VerticalAlignment = xlBottom
                .WrapText = True
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .MergeCells = False
            End With
            With rs.Range("E2", rs.Cells(lr, lc))
                .FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=""R"""
                .FormatConditions(.FormatConditions.Count).SetFirstPriority
                With rs.Range("E2", rs.Cells(lr, lc)).FormatConditions(1).Font
                    .Bold = True
                    .Italic = False
                    .Color = -16777024
                    .TintAndShade = 0
                End With
            End With
        End If
        For Each c In rs.Range("E2", rs.Cells(lr, lc))
            If c.Value = "R" Then
                c.HorizontalAlignment = xlHAlignCenter
            End If
        Next c
    Next rs
End Sub
 
Upvote 0
This works GREAT, JLGWhiz! I can't thank you enough. I will have to study it to see where I went awry.

If I wanted to incorporate column resizing in the same macro for columns E thru all columns to the right, where would you recommend I insert the attached code? I know this is a pain but I am developing for users with limited time and ability and am trying to automate as much as possible.


VBA Code:
Sub Resizecolumns()
'
' Resizecolumns Macro
'

'
    Columns("E:AH").Select
    Selection.ColumnWidth = 22
End Sub
 
Upvote 0
first of all, you don't neet to use 'Select. Instead, write it this way.
Code:
Columns("E:AH").ColumnWidth = 22
and you can put it just about anywhere between Sub and End Sub if you want it applied to the ActiveSheet, because without any other sheet being specified, that is where Excel will apply it. If you want it applied to the rs variable sheet then
Code:
rs.Columns("E:AH").ColumnWidth = 22
and put it inside the For loop.
 
Upvote 0

Forum statistics

Threads
1,212,933
Messages
6,110,752
Members
448,295
Latest member
Uzair Tahir Khan

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top