Hello,
I have this code to get the unique values based on the value that is entered on cell Z1 of sheet 1. These unique values are based on the cell number. Eg., $M$2, $M$3, etc. But the values that I am getting are everything that contains the value. E.g., $M$2, $M$24, $M$25, etc. Can I have your help on this?
Thank you.
I have this code to get the unique values based on the value that is entered on cell Z1 of sheet 1. These unique values are based on the cell number. Eg., $M$2, $M$3, etc. But the values that I am getting are everything that contains the value. E.g., $M$2, $M$24, $M$25, etc. Can I have your help on this?
VBA Code:
Sub RightClick_GetCellHistory()
Dim ActCell As String
Dim LastRow As Long
Application.ScreenUpdating = False
ActCell = ActiveCell.Address
With Sheet6
.Range("AA2:AE2,AA3:AE999").ClearContents
.Range("AC2").Value = ActCell
LastRow = .Range("A999").End(xlUp).Row
.Range("A1:E" & LastRow).AdvancedFilter xlFilterCopy, CriteriaRange:=.Range("AA1:AE2"), CopyToRange:=.Range("AA3:AE3"), Unique:=True
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=Range("AA4"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With .Sort
.SetRange Sheet6.Range("AA4:AE" & Sheet6.Range("AA999").End(xlUp).Row)
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With
Application.ScreenUpdating = True
End Sub
Sub RightClick_Call()
Dim cBut1 As CommandBarPopup
On Error Resume Next
With Application
.CommandBars("Cell").Controls("Cell History").Delete
Set cBut1 = .CommandBars("Cell").Controls.Add(Before:=1, Type:=msoControlPopup)
End With
With cBut1
.Caption = "Cell Change History"
If Sheet6.Range("AD4").Value <> Empty Then
With .Controls.Add(Type:=msoControlButton)
.Caption = Sheet6.Range("AB4").Value & " changed " & Format(Sheet6.Range("AD4").Value) & " to " & Format(Sheet6.Range("AE4").Value)
End With
End If
If Sheet6.Range("AD5").Value <> Empty Then
With .Controls.Add(Type:=msoControlButton)
.Caption = Sheet6.Range("AB5").Value & " changed " & Format(Sheet6.Range("AD5").Value) & " to " & Format(Sheet6.Range("AE5").Value)
End With
End If
If Sheet6.Range("AD6").Value <> Empty Then
With .Controls.Add(Type:=msoControlButton)
.Caption = Sheet6.Range("AB6").Value & " changed " & Format(Sheet6.Range("AD6").Value) & " to " & Format(Sheet6.Range("AE6").Value)
End With
End If
If Sheet6.Range("AD7").Value <> Empty Then
With .Controls.Add(Type:=msoControlButton)
.Caption = Sheet6.Range("AB7").Value & " changed " & Format(Sheet6.Range("AD7").Value) & " to " & Format(Sheet6.Range("AE7").Value)
End With
End If
End With
On Error GoTo 0
End Sub
Sub RightClick_Cancel()
On Error Resume Next
With Application
.CommandBars("Cell").Controls("Cell Change History").Delete
End With
On Error GoTo 0
End Sub
Thank you.