VBA to format tange of cells based off value in another cell

Access Beginner

Active Member
Joined
Nov 8, 2010
Messages
311
Office Version
  1. 2016
Platform
  1. Windows



I’m looking to format a range of cells based on a value in othercells.

On the “Menu” sheet I have the following table

[TABLE="width: 298"]
<tbody>[TR]
[TD="width: 231, bgcolor: transparent, colspan: 2"] Menu Sheet
[/TD]
[TD="width: 167, bgcolor: transparent"][/TD]
[/TR]
[TR]
[TD="width: 89, bgcolor: transparent"] Cell
[/TD]
[TD="width: 142, bgcolor: transparent"] Measure
[/TD]
[TD="width: 167, bgcolor: transparent"] Number Format
[/TD]
[/TR]
[TR]
[TD="width: 89, bgcolor: transparent"] A119
[/TD]
[TD="width: 142, bgcolor: transparent"] T1.1
[/TD]
[TD="width: 167, bgcolor: transparent"] $
[/TD]
[/TR]
[TR]
[TD="width: 89, bgcolor: transparent"] A120
[/TD]
[TD="width: 142, bgcolor: transparent"] T1.2
[/TD]
[TD="width: 167, bgcolor: transparent"] %
[/TD]
[/TR]
[TR]
[TD="width: 89, bgcolor: transparent"] A121
[/TD]
[TD="width: 142, bgcolor: transparent"] T1.3
[/TD]
[TD="width: 167, bgcolor: transparent"] %
[/TD]
[/TR]
[TR]
[TD="width: 89, bgcolor: transparent"] A122
[/TD]
[TD="width: 142, bgcolor: transparent"] T1.4
[/TD]
[TD="width: 167, bgcolor: transparent"] %
[/TD]
[/TR]
[TR]
[TD="width: 89, bgcolor: transparent"] A123
[/TD]
[TD="width: 142, bgcolor: transparent"] T1.5
[/TD]
[TD="width: 167, bgcolor: transparent"] #,###,###
[/TD]
[/TR]
[TR]
[TD="width: 89, bgcolor: transparent"] A124
[/TD]
[TD="width: 142, bgcolor: transparent"] T2.1
[/TD]
[TD="width: 167, bgcolor: transparent"] #,###,###
[/TD]
[/TR]
[TR]
[TD="width: 89, bgcolor: transparent"] A125
[/TD]
[TD="width: 142, bgcolor: transparent"] T2.2
[/TD]
[TD="width: 167, bgcolor: transparent"] %
[/TD]
[/TR]
[TR]
[TD="width: 89, bgcolor: transparent"] A126
[/TD]
[TD="width: 142, bgcolor: transparent"] T2.3
[/TD]
[TD="width: 167, bgcolor: transparent"] #,###,###
[/TD]
[/TR]
[TR]
[TD="width: 89, bgcolor: transparent"] A127
[/TD]
[TD="width: 142, bgcolor: transparent"] T2.4
[/TD]
[TD="width: 167, bgcolor: transparent"] $
[/TD]
[/TR]
[TR]
[TD="width: 89, bgcolor: transparent"] A128
[/TD]
[TD="width: 142, bgcolor: transparent"] T3.1
[/TD]
[TD="width: 167, bgcolor: transparent"] %
[/TD]
[/TR]
</tbody>[/TABLE]

In Cell B119 I have T1.1 and C119 I have the format I wantand so on down to B128.

On the “ISS_Charts” sheet in cells R64,R65,and R66 will havevalues ranging from T1.1 to T3.1. These values will change based on a drop downbox in another cell.

So in R64 if the value is T1.1 I’d like on sheet “ISS_Charts”,cellsC16,D16 and E16 to have the format of $. If R64 has the value of T1.2 I’d like cells,C16,D16and D16 to have the format of $ and so on.


Value in R65 determines the values on sheet “ISS_Charts” cellsC25,D25,E25.


Value in R66 determines the values on sheet “ISS_Charts” cellsC31,D31,E31.

I hope the above makes sense.



 

Excel Facts

Whats the difference between CONCAT and CONCATENATE?
The newer CONCAT function can reference a range of cells. =CONCATENATE(A1,A2,A3,A4,A5) becomes =CONCAT(A1:A5)
Paste this code in the Sheet module for the ISS_Charts worksheet:
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim FormatType As String
    Dim RangeToFormat As Range
    
    Select Case Target.Address
        Case "$R$64"
            FormatType = GetFormat(Target.Value)
            Set RangeToFormat = Range("C16:E16")
        Case "$R$65"
            FormatType = GetFormat(Target.Value)
            Set RangeToFormat = Range("C25:E25")
        Case "$R$66"
            FormatType = GetFormat(Target.Value)
            Set RangeToFormat = Range("C31:E31")
        Case Else
            Exit Sub
    End Select
    
    Select Case FormatType
        Case "$"
            RangeToFormat.Style = "Currency"
        Case "%"
            RangeToFormat.Style = "Percent"
        Case Is <> ""
            RangeToFormat.NumberFormat = FormatType
    End Select
End Sub

Private Function GetFormat(Lookup As String) As String
    Dim FoundCell As Range
    Dim LastCell As Range
    
    With Worksheets("Menu").Range("B119:B128")
        Set LastCell = .Cells(.Cells.Count)
    End With
    
    Set FoundCell = Worksheets("Menu").Range("B119:B128").Find(what:=Lookup, after:=LastCell)
    If Not FoundCell Is Nothing Then
        GetFormat = FoundCell.Offset(0, 1).Value
    End If
End Function
 
Upvote 0
Just another way

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Range("R64:R66")) Is Nothing Then
    If Target.Count > 1 Then Exit Sub
    Dim f As Range, r As Long, nf As Variant
    r = WorksheetFunction.Lookup(Target.Row, Array(64, 65, 66), Array(16, 25, 31))
    Set f = Sheets("Menu").Range("B119:B128").Find(Target.Value, , xlValues, xlWhole)
    If Not f Is Nothing Then
      nf = WorksheetFunction.Lookup(Left(f.Offset(, 1), 1), Array("#", "$", "%"), Array("#,###,###", "$0", "0%"))
      Range("C" & r & ":E" & r).NumberFormat = nf
    End If
  End If
End Sub

SHEET EVENT
Right click the tab of the sheet you want this to work, select view code and paste the code into the window that opens up.
 
Upvote 0

Forum statistics

Threads
1,224,828
Messages
6,181,217
Members
453,024
Latest member
Wingit77

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