Hi all, I have a macro contained within a sheet in a workbook. This macro is activated when the user clicks on a shape linked to the macro. The document contains an 'approval' section to sign off the content contained within it, and the purpose of the macro is to take the user's Windows user ID and enter it into a cell, thereby acting as a unique signature. There needs to be two separate signatories, so I want the VBA code to find duplicate values, warn the user of them and then remove the second signatory until it is unique from the first. The second signature macro is separate to the first signature macro, and they run independently from one another.
The part I cannot get working is the duplicate value part. It's treating any value entered into the range of cells as duplicate, when it's been proven through testing that they're not. The range of cells in this macro are merged (C36 - C38 create one signature box, cells C39 - C41 create the other). Anybody know what's going wrong here?
The part I cannot get working is the duplicate value part. It's treating any value entered into the range of cells as duplicate, when it's been proven through testing that they're not. The range of cells in this macro are merged (C36 - C38 create one signature box, cells C39 - C41 create the other). Anybody know what's going wrong here?
VBA Code:
Sub Approve_Change_2()
Dim ws As Worksheet
Set ws = ActiveSheet
Dim cell As Range
Dim rng As Range
Dim ees As Range
Dim myArray As Variant
Dim x As Integer
' check to see if the approver 1 fields are empty
If ActiveSheet.Range("B36, B37").Value = "" Then Exit Sub
'confirm user wants to approve
If MsgBox("Are you sure you wish to approve the change request detailed above?", vbYesNo) = vbNo Then Exit Sub
''this part of the code checks that all required fields have values in them
For Each cell In ws.Range("A11,A13,B7,B8,D6")
If cell.Value <> "" Then
GoTo NextStep
Else
MsgBox "Please ensure all required fields are completed before approval is given"
Exit Sub
End If
Next
NextStep:
'' cells which remain unlocked after company signatures are received are controlled in the cell properties window
ActiveSheet.Unprotect
'' this part of the code enters the approver's name (based on their Windows log on) and removes the full stop between first and last name
ws.Range("C39").Value = Environ$("Username")
Range("C39").Select
ActiveCell.Replace What:=".", Replacement:=" ", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
Cells.Find(What:=".", After:=ActiveCell, LookIn:=xlFormulas2, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
''this code enters the date the approval was made
ws.Range("D39").Value = Format(Now, "dd/mm/yyyy, hh:mm")
ActiveSheet.Protect
'check for duplicate approver
'Look for duplicates
Set rng = Range("C36:C41")
'Test Range for Duplicates
If Evaluate(Replace("NOT(AND((COUNTIF(@,@)=1)))", "@", rng.Address)) = True Then
MsgBox "Both approvers cannot be the same, please review and amend."
Range("B39").Clear
Range("B40").Clear
Range("C39:C40").Value = ""
Range("D39:D40").Value = ""
ActiveSheet.Unprotect
Exit Sub
Else
ActiveSheet.Protect
End If
End Sub
