adrielyeung/macro-workbook

Please add this macro

Closed this issue · 0 comments

Sub AddHyperlink()
'
' AddHyperlink Macro
' Batch add hyperlinks to each row in a column (skipping first row).
' Link to another column in the same row.
'

'
    Dim i As Integer
    
    For i = 2 To ActiveSheet.UsedRange.Rows.Count
    
        Range("B" & i).Value = "SMS"
        
        ActiveSheet.Hyperlinks.Add Anchor:=Range("B" & i), Address:="", SubAddress:= _
            "NoticeTriggerDetail!K" & i, TextToDisplay:="SMS"
    Next i
    
End Sub
Sub HyperlinkToNewSheet()
'
' HyperlinkToNewSheet Macro
' Add a new Sheet for each
'

'
    Dim i As Integer
    
    For i = 2 To ActiveSheet.UsedRange.Rows.Count
        Range("C" & i).Value = "" & i - 1 & "-English"
        Range("D" & 1).Value = "" & i - 1 & "-Chinese"
        
        Sheets.Add(After:=Sheets(Sheets.Count)).Name = Sheets("NoticeTriggerDetail").Range("C" & i).Value
        
        ActiveSheet.Hyperlinks.Add Anchor:=Range("A1"), Address:="", SubAddress:= _
            "NoticeTriggerDetail!C" & i, TextToDisplay:="Back to main"
        
        Sheets.Add(After:=Sheets(Sheets.Count)).Name = Sheets("NoticeTriggerDetail").Range("D" & 1).Value
        
        ActiveSheet.Hyperlinks.Add Anchor:=Range("A1"), Address:="", SubAddress:= _
            "NoticeTriggerDetail!D" & i, TextToDisplay:="Back to main"
        
        Sheets("NoticeTriggerDetail").Select
        
        Sheets("NoticeTriggerDetail").Hyperlinks.Add Anchor:=Range("C" & i), Address:="", SubAddress:= _
            "'" & Range("C" & i).Value & "'!A1", TextToDisplay:=Range("C" & i).Value
        Sheets("NoticeTriggerDetail").Hyperlinks.Add Anchor:=Range("D" & i), Address:="", SubAddress:= _
            "'" & Range("D" & 1).Value & "'!A1", TextToDisplay:=Range("D" & 1).Value
            
        Range("C" & i).Font.Name = "Arial"
        Range("D" & i).Font.Name = "Arial"
    Next i
End Sub

Sub UpdateHyperlink()
    Dim i As Integer
    
    For i = 2 To Sheets.Count
        Sheets(i).Select
        
        If Mid(Sheets(i).Name, 4) = "English" Then
            Sheets(i).Hyperlinks.Add Anchor:=Sheets(i).Range("A1"), Address:="", SubAddress:= _
                "NoticeTriggerDetail!E" & Left(Sheets(i).Name, 2) + 1, TextToDisplay:="Back to main"
        Else
            Sheets(i).Hyperlinks.Add Anchor:=Sheets(i).Range("A1"), Address:="", SubAddress:= _
                "NoticeTriggerDetail!F" & Left(Sheets(i).Name, 2) + 1, TextToDisplay:="Back to main"
        End If
        
        Range("A1").Font.Name = "Arial"
    Next i
    
    Sheets(1).Select
End Sub
Sub OpenCloseTicket()
' CloseTicket Macro
' Open/Close ticket inputting ticket number.
'

'
    Dim TicketNum As String, TicketRow As Long
    
    Do While True
        TicketNum = InputBox("Enter ticket number (AHxxxxx):", "Ticket #")
        If IsNumeric(Mid(TicketNum, 3)) And Left(TicketNum, 2) = "AH" Then
            Exit Do
        End If
        If MsgBox("Please enter a valid ticket number (AHxxxxx).", vbOKCancel, "Number required") = vbCancel Then Exit Sub
    Loop
    
    TicketRow = MatchLast(TicketNum, Range("D:D"), 1)
    
    If Len(Range("I" & TicketRow).Value) = 0 Then
        Range("F" & TicketRow).Value = "Working in progress"
        Range("I" & TicketRow).Value = "Adriel"
        Range("J" & TicketRow).Value = "Other systems"
        Range("K" & TicketRow).Value = Date
        Range("L" & TicketRow).Value = Date + FindNextWorkday()
        Range("M" & TicketRow).Value = "50%"
        MsgBox "Ticket #" & TicketNum & " opened.", vbOKOnly, "Ticket opened"
    Else
        Range("F" & TicketRow).Value = "Closed"
        Range("G" & TicketRow).Value = Date
        Range("M" & TicketRow).Value = "100%"
        MsgBox "Ticket #" & TicketNum & " closed.", vbOKOnly, "Ticket closed"
    End If
End Sub
Sub RenewTicket()
'
' RenewTicket Macro
' Renew tickets that are due today or before.
'

'
    Dim CurRow As Integer, EndRow As Integer
    CurRow = ActiveSheet.UsedRange.Rows.Count
    EndRow = 2
    
    While CurRow >= EndRow
        ' Valid ticket
        If Len(Range("D" & CurRow).Value) > 0 Then
            ' Only check last 100 valid tickets
            If EndRow = 2 Then
                EndRow = CurRow - 100
            End If
            
            ' My ticket
            If Range("I" & CurRow).Value = "Adriel" Then
                ' Status not closed and due today or before
                If Range("L" & CurRow).Value <= Date + 1 _
                    And Not Range("F" & CurRow).Value = "Closed" Then
                    Range("L" & CurRow).Value = Date + FindNextWorkday()
                End If
            End If
        End If
        CurRow = CurRow - 1
    Wend
    
    MsgBox "Renewed your tickets successfully.", vbOKOnly, "Tickets renewed"
    
End Sub

Function FindNextWorkday()
    If Weekday(Date, vbMonday) >= 5 Then
        FindNextWorkday = 4
    Else
        FindNextWorkday = 2
    End If
End Function

Function MatchLast(Lookupvalue As String, LookupRange As Range, ColumnNumber As Integer) As Long
' MatchLast Function
' Returns last cell row number in LookupRange, ColumnNumber'th column containing Lookupvalue
'
    Dim i As Long
    For i = LookupRange.Columns(ColumnNumber).Cells.Count To 1 Step -1
        If Lookupvalue = LookupRange.Cells(i, 1) Then
            MatchLast = i
            Exit Function
        End If
    Next i
End Function