Untitled

mail@pastecode.io avatar
unknown
plain_text
a month ago
1.9 kB
2
Indexable
Never
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range
    Dim btn As Button

    ' Define the range to monitor for changes (Column N, starting from row 2)
    Set rng = Worksheets("Sheet1").Range("N2:N" & Worksheets("Sheet1").Cells(Rows.Count, "N").End(xlUp).Row)

    If Not Intersect(Target, rng) Is Nothing Then
        ' Check if the percentage complete is greater than or equal to 70%
        If Target.Value >= 0.7 Then
            ' Add a button in Column V of the same row
            Set btn = Worksheets("Sheet1").Buttons.Add(Target.Offset(0, 9).Left, _
                Target.Offset(0, 9).Top, Target.Offset(0, 9).Width, Target.Offset(0, 9).Height)

            With btn
                .OnAction = "btn_Click"
                .Caption = "Show Info"
                .Name = "btn" & Target.Row
            End With
        End If
    End If
End Sub

Sub btn_Click()
    Dim btn As Button
    Dim contractNumber As String
    Dim percentageComplete As Double
    Dim email As String
    Dim row As Long

    ' Get the button that was clicked
    Set btn = Worksheets("Sheet1").Buttons(Application.Caller)

    ' Get the row number from the button's name
    row = CLng(Mid(btn.Name, 4))

    ' Get the contract number, percentage complete, and email from the corresponding row
    contractNumber = Worksheets("Sheet1").Cells(row, "A").Value
    percentageComplete = Worksheets("Sheet1").Cells(row, "N").Value
    email = Worksheets("Sheet1").Cells(row, "U").Value

    ' Display a message box with the contract number, percentage complete, and email
    MsgBox "Contract Number: " & contractNumber & vbNewLine & _
           "Percentage Complete: " & Format(percentageComplete, "Percent") & vbNewLine & _
           "Email: " & email, vbInformation, "Project Information"
End Sub
Leave a Comment