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

Access Beginner

Active Member
Joined
Nov 8, 2010
Messages
307
Office Version
2016
Platform
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

Menu Sheet
Cell
Measure
Number Format
A119
T1.1
$
A120
T1.2
%
A121
T1.3
%
A122
T1.4
%
A123
T1.5
#,###,###
A124
T2.1
#,###,###
A125
T2.2
%
A126
T2.3
#,###,###
A127
T2.4
$
A128
T3.1
%
<tbody> </tbody>

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.



 

Some videos you may like

Excel Facts

Which came first: VisiCalc or Lotus 1-2-3?
Dan Bricklin and Bob Frankston debuted VisiCalc in 1979 as a Visible Calculator. Lotus 1-2-3 debuted in the early 1980's, from Mitch Kapor.

shknbk2

Board Regular
Joined
Mar 5, 2016
Messages
235
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
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
10,225
Office Version
2007
Platform
Windows
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.
 

Watch MrExcel Video

Forum statistics

Threads
1,090,026
Messages
5,411,923
Members
403,404
Latest member
BBleaz

This Week's Hot Topics

Top