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:
One last topic, I hope. Is there a way to automatically wrap text? This Excel workbook uses the connections feature to obtain data from an Access database and the column headings can vary in length. I found there is ".WrapText = True"so would that be in the same place as the ColumnWidth and read as attached
Code:
rs.Columns("E:AH").WrapText = True
? If I 'hardcode' in AH as the final column, what happens if there are additional columns (these are classes and can vary from in number from time to time)?
Again, thank you for your valuable time and excellent explanations!
 
Upvote 0

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.
Have you tried putting that line into the code at the same place? The worst thing that can happen is that an error will be generated if it is not correct, or that it would apply to the wrong sheet. But the answer is yes, it would go inside the For loop to be applied to the variable rs sheet. If you want to make the columns dynamic, the it can be done like this.
Code:
rs.Range("E1",  rs.Cells(1, Columns.Count).End(xlToLeft)).EntireColumn.WrapText = True
Then if you add or delete columns the column range will adjust accorfdingly based on row 1 data entries. To make it universally dynamic would take some additional code.
 
Upvote 0
I tried your recommended code, but it didn't work so I reverted to the "short" version I asked about and it worked. In looking closer at that whole section, .WrapText =True is already specified (between VerticalAlignment and Orientation). Why didn't that suffice? There's always a reason for these things to happen, and it is logical--once I understand it.
VBA 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
                rs.Columns("E:AH").ColumnWidth = 22
                rs.Columns("E:AH").WrapText = True
            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
Why didn't that suffice?
Not sure I know exactly why it wouldn't work. It should, according to the MS spec sheet. WrapText is a Range property, so it should be applied to any valid range with the syntax
Range.WrapText = True
I have in the past had problems using the Columns property to apply certain attributes to multiple columns and have had to use the Range method instead. I remember reading something about that but could not find it again in this instance. I know I have it somewhere but senility has set in and I will just have to wait until I stumble across it again.
Regards, JLG
 
Upvote 0
JLGWhiz, thank you so very much for all your valuable time and expertise. Your code and explanations are clear and helpful.
 
Upvote 0
VBA 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
                rs.Columns("E:AH").ColumnWidth = 22
                rs.Columns("E:AH").WrapText = True
            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
Oops, sorry. Just when I thought I was home free, I began getting a run time 91 error starting on 4th line of VBA (lc). It was working fine yesterday. The only difference today was a mandatory update. My research is confusing; some say it can have something to do with a file 'DCOMCnfg.exe’ being corrupted (I have restarted the computer with no luck); others say it has to do with looping thru the Worksheets.

If it isn't one thing, it is another.
VBA 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
                rs.Columns("E:AH").ColumnWidth = 22
                rs.Columns("E:AH").WrapText = True
            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
Using your code, the only way I could get the error was to run the code against a blank sheet.. Here is a fix for that.

Code:
Sub rgtalgnredRctr()
Dim rs As Worksheet, c As Range, lc As Long, lr As Long
    For Each rs In ThisWorkbook.Worksheets
        If Application.CountA(rs.Cells) <> 0 Then
        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
                rs.Columns("E:AH").ColumnWidth = 22
                rs.Columns("E:AH").WrapText = True
            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
        End If
    Next rs
End Sub
 
Upvote 0
I wondered if that was the case. Each tab may not have details based on the weekly data, only the header type information which comprises the first 3 rows. I tried going to a tab with data on it, but that didn't seem to work. I am eager to try your solution tomorrow as I am updating the accompanying documentation for running the whole procedure. Many thanks again for your expertise. I'll let you know the outcome.
 
Upvote 0
JLGWhiz, you are a wizard! It works perfectly. Thank you, thank you, thank you!
I hope this thread will help someone else in the future.
Best wishes always to you!
 
Upvote 0

Forum statistics

Threads
1,213,546
Messages
6,114,253
Members
448,556
Latest member
peterhess2002

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