Remove all your existing code, and just use this in the sheet module.
Code:Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target.Cells(1), Range("D1:E1,D4:E4")) Is Nothing Then Application.EnableEvents = False End If If Not Intersect(Target.Cells(1), Range("E1,E4")) Is Nothing Then Target.Cells(1, 0).Value = Range("G" & Application.Match(Target.Cells(1).Value, Range("H1:H10"), 0)).Value Target.Cells(1, 0).Resize(, 2).Interior.ColorIndex = Target.Cells(1).Value ElseIf Not Intersect(Target.Cells(1), Range("D1,D4")) Is Nothing Then Target.Cells(1, 2).Value = Range("H" & Application.Match(Target.Cells(1).Value, Range("G1:G10"), 0)).Value Target.Cells(1).Resize(, 2).Interior.ColorIndex = Target.Cells(1, 2).Value End If ColorBar_1 ColorBar_2 Application.EnableEvents = True End Sub Sub ColorBar_1() With ActiveSheet.ChartObjects("Chart 1026").Chart.SeriesCollection(1) .Shadow = False .InvertIfNegative = False With .Border .Weight = xlThin .LineStyle = xlAutomatic End With With .Interior .ColorIndex = Sheets("Sheet2").Range("$E$1").Value .Pattern = xlSolid End With End With End Sub Sub ColorBar_2() With ActiveSheet.ChartObjects("Chart 1026").Chart.SeriesCollection(2) .Shadow = False .InvertIfNegative = False With .Border .Weight = xlThin .LineStyle = xlAutomatic End With With .Interior .ColorIndex = Sheets("Sheet2").Range("$E$4").Value .Pattern = xlSolid End With End With End Sub




Reply With Quote
Bookmarks