Please add this macro
Closed this issue · 0 comments
adrielyeung commented
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