Posts by Marius44

Option Explicit

Private Sub Chart_Activate()
Dim Ser As Series, i As Long, r As Integer, g As Integer, b As Integer
Dim ptname As String
Dim lngColor As Long, colR(1 To 131), colG(1 To 131), colB(1 To 131)
Application.ScreenUpdating = False
For i = 4 To 134
  lngColor = Worksheets("Meow").Cells(i, 7).DisplayFormat.Interior.Color
  r = lngColor Mod &H100
  lngColor = lngColor \ &H100
  g = lngColor Mod &H100
  lngColor = lngColor \ &H100
  b = lngColor Mod &H100
  colR(i - 3) = r
  colG(i - 3) = g
  colB(i - 3) = b
Next i
Sheets("Graph....").Activate
With ActiveChart
  For Each Ser In .SeriesCollection
    For i = 1 To Ser.Points.Count
      ptname = WorksheetFunction.Index(Ser.XValues, i)
      If Ser.Name = "Actual" Then
        Ser.Points(i).Select
        With Selection.Format.Line
          .Visible = msoTrue
          .ForeColor.RGB = RGB(colR(i), colB(i), colG(i))
          .Weight = 2
        End With
      Else
        Exit For
      End If
    Next i
  Next Ser
End With
Application.ScreenUpdating = True
End Sub

Sub CountNonZero()
ur = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To ur
  trg = Sheets("Sheet1").Cells(i, 1).Value
  For j = 3 To ur
    cnt = Sheets("Sheet2").Cells(j, 1).Value
    If trg = cnt Then
      Rng = "B" & j & ":P" & j
      nn = Application.WorksheetFunction.CountIfs(Sheets("Sheet2").Range(Rng), ">0")
      Sheets("Sheet1").Cells(i, 4) = nn
      nn = 0
      Exit For
    End If
  Next j
Next i
End Sub

Option Explicit


Sub RangeColor()
Dim sh1 As Worksheet, sh2 As Worksheet
Dim ur As Long, i As Long, j As Long, k As Long
Dim startlimit As Variant, proxlimit As Variant, endlimit As Variant
Dim aa As String, bb As String, cc As String, area_one As String, area_two As String


Set sh1 = Sheets("control Panel")
Set sh2 = Sheets("Master File")
ur = sh2.Cells(Rows.Count, 1).End(xlUp).Row


With sh1
  startlimit = .Cells(9, 6).Value
  proxlimit = .Cells(12, 6).Value
  endlimit = .Cells(15, 6).Value
End With


For i = 2 To ur
  If sh2.Cells(i, 1) = startlimit Then
    aa = "$B$" & i
    For j = i + 1 To ur
      If sh2.Cells(j, 1) = proxlimit Then
        bb = "$L$" & j
        GoTo xit_one
      End If
    Next j
  End If
Next i
xit_one:
area_one = aa & ":" & bb
For k = 2 To ur
  If sh2.Cells(k, 1) = endlimit Then
    cc = "$B$" & k
    GoTo xit_two
  End If
Next k
xit_two:
area_two = "$B$" & j + 1 & ":$L$" & k


sh2.Select
Range("B2:L" & ur).Interior.Color = xlNone
' Make yellow background
Range(area_one).Interior.Color = 13434879
' Make green background
Range(area_two).Interior.Color = 13434828
Set sh1 = Nothing
Set sh2 = Nothing
End Sub