Announcement

Collapse
No announcement yet.

Run macro based on the value in a cell

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • Run macro based on the value in a cell



    Hello guys,

    I am a VBA rookie trying to put together something for my boss, and I am stuck at one point.

    What I am trying to do is having rectangles show up and disappear based on whether the value in the cell is a "0" or a "1". This is simply being done by using a macro to change the transparency to 100% or 0% depending on the respective value.

    Here is the macro:
    Code:
    Sub GF6_1()
    If ThisWorkbook.Sheets("Sheet1").Range("U6").Value = "1" Then
        ActiveSheet.Shapes.Range(Array("Frame 15")).Select
        With Selection.ShapeRange.Fill
            .Visible = msoTrue
            .ForeColor.ObjectThemeColor = msoThemeColorDark1
            .ForeColor.TintAndShade = 0
            .ForeColor.Brightness = 0
            .Transparency = 0
            .Solid
        End With
        ActiveSheet.Shapes.Range(Array("Rectangle 6")).Select
        ActiveSheet.Shapes.Range(Array("Frame 15")).Select
        With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 1).Font.Fill
            .Visible = msoTrue
            .ForeColor.RGB = RGB(0, 0, 0)
            .Transparency = 0
            .Solid
        End With
        Range("A1").Select
        Else
        ActiveSheet.Shapes.Range(Array("Frame 15")).Select
        With Selection.ShapeRange.Fill
            .Visible = msoTrue
            .ForeColor.ObjectThemeColor = msoThemeColorDark1
            .ForeColor.TintAndShade = 0
            .ForeColor.Brightness = 0
            .Transparency = 1
            .Solid
        End With
        With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 1).Font.Fill
            .Visible = msoTrue
            .ForeColor.RGB = RGB(0, 0, 0)
            .Transparency = 1
            .Solid
        End With
        Range("A1").Select
        End If
    End Sub
    This works, but only halfway. I put my "0" or "1" in the cell but I have to manually run the macro each time. Based on my value, the rectangles appear and disappear as expected.

    However, I want to be able to run the macro automatically every time I enter a value in the cell! Does anyone know how this could be done? Perhaps have the adjacent cell use an IF formula and be able to execute the macro? I am stuck! I would appreciate any help on the matter, and please note you may have to use some layman terms!

    Let me know if you would prefer me to attach/send you the Excel file, it just rectangles as I am trying to get it to work before populating it fully. I can message it to you if you want to take a closer look at what I am doing wrong.

    Thanks in advance for your help.

  • #2
    Re: Run macro based on the value in a cell

    Hi,

    For this the code has to be in worksheet change event not a regular module. For this in VBA window double click on the worksheet icon and place the below code.
    Code:
     
    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
        If ThisWorkbook.Sheets("Sheet1").Range("U6").Value = "1" Then
            ActiveSheet.Shapes.Range(Array("Frame 15")).Select
            With Selection.ShapeRange.Fill
                .Visible = msoTrue
                .ForeColor.ObjectThemeColor = msoThemeColorDark1
                .ForeColor.TintAndShade = 0
                .ForeColor.Brightness = 0
                .Transparency = 0
                .Solid
            End With
            ActiveSheet.Shapes.Range(Array("Rectangle 6")).Select
            ActiveSheet.Shapes.Range(Array("Frame 15")).Select
            With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 1).Font.Fill
                .Visible = msoTrue
                .ForeColor.RGB = RGB(0, 0, 0)
                .Transparency = 0
                .Solid
            End With
            Range("A1").Select
        Else
            ActiveSheet.Shapes.Range(Array("Frame 15")).Select
            With Selection.ShapeRange.Fill
                .Visible = msoTrue
                .ForeColor.ObjectThemeColor = msoThemeColorDark1
                .ForeColor.TintAndShade = 0
                .ForeColor.Brightness = 0
                .Transparency = 1
                .Solid
            End With
            With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 1).Font.Fill
                .Visible = msoTrue
                .ForeColor.RGB = RGB(0, 0, 0)
                .Transparency = 1
                .Solid
            End With
            Range("A1").Select
        End If
     
    End Sub
    Exceleb

    Comment


    • #3
      Re: Run macro based on the value in a cell

      This works! Thanks so much. I am currently trying to tweak my code a little bit as it keeps selecting Cell A1 and/or the Frame itself, and I have to click it a few times to be able to change the values in the cell. I am learning as we go. Thanks again.

      Originally posted by exceleb View Post
      Hi,

      For this the code has to be in worksheet change event not a regular module. For this in VBA window double click on the worksheet icon and place the below code.
      Code:
       
      Private Sub Worksheet_SelectionChange(ByVal Target As Range)
          If ThisWorkbook.Sheets("Sheet1").Range("U6").Value = "1" Then
              ActiveSheet.Shapes.Range(Array("Frame 15")).Select
              With Selection.ShapeRange.Fill
                  .Visible = msoTrue
                  .ForeColor.ObjectThemeColor = msoThemeColorDark1
                  .ForeColor.TintAndShade = 0
                  .ForeColor.Brightness = 0
                  .Transparency = 0
                  .Solid
              End With
              ActiveSheet.Shapes.Range(Array("Rectangle 6")).Select
              ActiveSheet.Shapes.Range(Array("Frame 15")).Select
              With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 1).Font.Fill
                  .Visible = msoTrue
                  .ForeColor.RGB = RGB(0, 0, 0)
                  .Transparency = 0
                  .Solid
              End With
              Range("A1").Select
          Else
              ActiveSheet.Shapes.Range(Array("Frame 15")).Select
              With Selection.ShapeRange.Fill
                  .Visible = msoTrue
                  .ForeColor.ObjectThemeColor = msoThemeColorDark1
                  .ForeColor.TintAndShade = 0
                  .ForeColor.Brightness = 0
                  .Transparency = 1
                  .Solid
              End With
              With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 1).Font.Fill
                  .Visible = msoTrue
                  .ForeColor.RGB = RGB(0, 0, 0)
                  .Transparency = 1
                  .Solid
              End With
              Range("A1").Select
          End If
       
      End Sub

      Comment


      • #4


        Re: Run macro based on the value in a cell

        Happy to help!
        Exceleb

        Comment

        Working...
        X