VBA code is not retrieving unique values

YingFa

Board Regular
Joined
Nov 4, 2019
Messages
63
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?

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.
 

Excel Facts

Best way to learn Power Query?
Read M is for (Data) Monkey book by Ken Puls and Miguel Escobar. It is the complete guide to Power Query.
The code you have posted does nothing like what you describe in your narrative.
 
Upvote 0
The code you have posted does nothing like what you describe in your narrative.

These codes are also part of it. Maybe it makes more sense to you having all of them. But everything works well except for the unique values.

VBA Code:
Private Sub Worksheet_Activate()
RightClick_Call
End Sub

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
RightClick_Cancel
RightClick_GetCellHistory
RightClick_Call
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("M2:M9999")) Is Nothing Then
If ActiveSheet.Name = "CalibrationList" Then
   Range("Z1").Value = Target.Address
   AddToLog
End If
End If
End Sub

Private Sub Worksheet_Deactivate()
RightClick_Cancel
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("M2:M9999")) Is Nothing Then
   Range("AB1").Value = Target.Row
   Range("AD1").Value = Target.Value
End If
End Sub

Code:
Private Sub Workbook_Deactivate()
RightClick_Cancel
End Sub

Private Sub Workbook_Open()

End Sub

Code:
Sub AddToLog()
Dim ActRow, LogRow As Long
With Sheet2
   ActRow = .Range("AB1").Value
   LogRow = Sheet6.Range("A999").End(xlUp).Row + 1
   Sheet6.Range("A" & LogRow).Value = Now
   Sheet6.Range("B" & LogRow).Value = Environ("UserName")
   Sheet6.Range("C" & LogRow).Value = .Range("Z1").Value
   Sheet6.Range("D" & LogRow).Value = .Range("AD1").Value
   Sheet6.Range("E" & LogRow).Value = .Range(.Range("Z1").Value).Value
End With
End Sub
 
Upvote 0
AdvancedFilter regards "unique" as any cell in the row is different. Even if you are filtering on Name, AdvancedFilter will return both
Bob Smith | cow and Bob Smith | goat as two unique results.
 
Upvote 0
AdvancedFilter regards "unique" as any cell in the row is different. Even if you are filtering on Name, AdvancedFilter will return both
Bob Smith | cow and Bob Smith | goat as two unique results.
Thank you for your answer. What should I use to get a unique value? I'm lost now.
 
Upvote 0
But my code is using AdvanceFilter and still, it does not give me unique values. It pulls everything that contains the value.
 
Upvote 0
If your criteria range AA1:AE2 is not set up properly, it could cause undesired results with advanced filter. Remember data on the same row of the cirteria range makes the AND operator active while data on consecutive rows of the same column make the OR operator active. Multicolumn AdvancedFilter can be troublesome. Especially when there is a maze of procedure calls to set up the cirteria.
 
Upvote 0

Forum statistics

Threads
1,213,554
Messages
6,114,280
Members
448,562
Latest member
Flashbond

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top