pull unique values from a column as they appear

[jonattempt_cell]

I am trying to write a vba function, sub or to call a sub / function that would pull unique values in a column's range to another, larger column on the same or different worksheet. I want to pull the unique values as they appear because they may disappear.

Imagine for example people enter a restaurant and orders arrive to the chef but are thrown i nthe bin once they leave. Each order has a unique receipt and I'd like that receipt to be recorded and entered in the last empty row of the destination column.

For example column B3:B30 contains the receipt id for customers as they arrive. I'd need column C:C to record to the last empty cell the unique orders as they arrive. As people leave the restaurant column B3:B30 will fill to the top so the code will need to adjust and search the whole of B3:B30

so far I have

<code>Sub ertdfgcvb()
Dim rng As Range
Dim Unique As Boolean

For Each rng In Worksheets("Sheet1").Range("B1:B30") 'for each cell in your B1 to B30 range, sheet1
    Unique = True 'we'll assume it's unique
    Lastunique = Worksheets("Sheet2").Range("B:B").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    For i = 1 To Lastunique 'for each cell in the unique ID cache
        If rng.Value = Worksheets("Sheet2").Cells(i, 2).Value Then 'we check if it is equal
            Unique = False 'if yes, it is not unique
        End If
    Next
    If Unique Then Worksheets("Sheet2").Cells(Lastunique + 1, 2) = rng 'adds if it is unique
Next
End Sub

</code>
<code><code>

Private Sub WorkSheet_Change(ByVal Target As Range)
Call ertdfgcvb
End Sub

</code>

Private Sub WorkSheet_Change(ByVal Target As Range)
Dim rng As Range
most = Now
For Each rng In Target
    If rng.Column = 2 Then 'if it's in B column
        Unique = True 'we'll assume it's unique
        Lastunique = Worksheets("Sheet2").Range("B:B").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        For i = 1 To Lastunique 'for each cell in the unique ID cache
            If rng.Value = Worksheets("Sheet2").Cells(i, 2).Value Then 'we check if it is equal
                Unique = False 'if yes, it is not unique
            End If
        Next
        If Unique Then Worksheets("Sheet2").Cells(Lastunique + 1, 2) = rng 'adds if it is unique
    End If
Next
MsgBox (Format(Now - most, "h:mm:ss"))
End Sub</code>

but none seem to work

 

[jonattempt_cell]

I get an error on line

Lastunique = Worksheets("Sheet2").Range("B:B").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

someone suggested to use

<code>Intersect(Target, Range("B1:B30")) Is Nothing Then 'Do nothing 'else process the changed value Else

but I don't know how to adjust it for this.

Would calling the sub mean that everytime cells B3:30 change ( or I think above example uses B1:B30 ) then it would update
</code>

 

[MickG]

You might like to try this "Worksheet_Change", Event:-
The code will run when you change a value in column "B" (B2 on), and will update column "C" with a the unique values in column"B".
If you change or delete a value in column "B" that value will still show in column "C".

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range, Dn As Range, n As Long
Dim RngB As Range, RngC As Range
If Target.Column = 2 And Target.Count = 1 And Target.Row > 1 Then
With CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
Set RngB = Range(Range("B2"), Range("B" & Rows.Count).End(xlUp))
Set RngC = Range(Range("C2"), Range("C" & Rows.Count).End(xlUp))
ray = Array(RngB, RngC)
    For n = 0 To 1
        For Each Dn In ray(n)
            If Not Dn.Address(0, 0) = "C1" And Not Dn.Value = "" Then
                .Item(Dn.Value) = Empty
            End If
        Next Dn
    Next n
Range("C2").Resize(.Count) = Application.Transpose(.Keys)
End With
End If

 

[jonattempt_cell]

I don't know how to insert worksheet change events. Do I just click on the sheet in question on vba editor change dropdown from geenral to worksheet the paste over the existing then it runs like a function or formula dragged across the range or whatever , whenever the change occurs. If so this code isn't working ..

shouldn't there be an end sub on the end of your code?


I have hope in your code except I got an erorr on line

Range("C2").Resize(.Count) = Application.Transpose(.Keys)

 

[MickG]

Well spotted , There is also an undimensioned variable "Ray"
NB:- This code should work unless your running a "Mac"

I'll try again:-

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range, Dn As Range, n As Long
Dim RngB As Range, RngC As Range, Ray
If Target.Column = 2 And Target.Count = 1 And Target.Row > 1 Then
With CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
Set RngB = Range(Range("B2"), Range("B" & Rows.Count).End(xlUp))
Set RngC = Range(Range("C2"), Range("C" & Rows.Count).End(xlUp))
Ray = Array(RngB, RngC)
    For n = 0 To 1
        For Each Dn In Ray(n)
            If Not Dn.Address(0, 0) = "C1" And Not Dn.Value = "" Then
                .Item(Dn.Value) = Empty
            End If
        Next Dn
    Next n
Range("C2").Resize(.Count) = Application.Transpose(.Keys)
End With
End If
End Sub

To add the code:-
Right click the data sheet Tab, select "View code".
Paste code into Vb window.
Close VB window.
Run code by Altering/Inserting value in column "B"

 

[jonattempt_cell]

brilliant - your code works but how can I do it from Sheet1 FY3:FY30 to SHeet2 FD:FD or FD3 Downwards if I have a header in FD1 and / or FD2

 

[jonattempt_cell]

MickG your code is great actually except for one thing that when the cells fill to the destination they don't fill to the last row and stay in the order in that they arrived there. If anyone can suggest how to change this workchange event to function properly that would solve the problem.

The worksheet change event is

<code>Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("FS3:FS33")) Is Nothing Then
'Do nothing '
Else
Call hithere3
End If
End Sub

and the sub it is referencing is

</code><code>Sub hithere3()
Dim Rng As Range
Dim Unique As Boolean

For Each Rng In Worksheets("Sheet8").Range("FS3:FS33") 'for each cell     in     your B1 to B30 range, sheet1
Unique = True 'we'll assume it's unique
Lastunique = Worksheets("TRADES").Range("C:C").Find("*",     SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
For i = 3 To Lastunique 'for each cell in the unique ID cache
    If Rng.Value = Worksheets("TRADES").Cells(i, 3).Value Then 'we       check    if it is equal
        Unique = False 'if yes, it is not unique
    End If
Next
If Unique Then Worksheets("TRADES").Cells(Lastunique + 1, 3) = Rng 'adds    if it is unique
Next
End Sub

the change event works </code>except it only updates when I select one of the cells in FS3:FS33
Can anyone suggest how this can be overcome? thanks in advance

 

[jonattempt_cell]

does anyone have a solution to this? I have been trying to do this for three days but now Im thinking about trying to use indirect, select the range and use a basic

Function macropastec4() As Variant
    macropastec4 = Sheets("Account Details --->").Range("I3").Value
End Function

although I think I will probably get know-where

as I will have to have 33 values of the sub

 

[MickG]

It not clear to me what the difference is in the requirements, I have catered for and the requirements you want.
I have catered for data in the active sheet columns B (for the Input) column "C" for the (results).
What are your requirements in terms of "Input data" column, and "Results" column.
Please try and show an example of input data & results and other requirements you would like.
It is much easier to write code from the data and expected results , rather than some code that has already failed!!!

 

[jonattempt_cell]

It not clear to me what the difference is in the requirements, I have catered for and the requirements you want.
I have catered for data in the active sheet columns B (for the Input) column "C" for the (results).
What are your requirements in terms of "Input data" column, and "Results" column.
Please try and show an example of input data & results and other requirements you would like.
It is much easier to write code from the data and expected results , rather than some code that has already failed!!!

thanks MickG but basically in column B I have formulas like if(D3="","",D3) so when D3 is not blank it will show the number in D3

lets say cell D3 has something more complex like

=IFERROR(INDEX('Open Positions --->'!$B$3:$O$1084,$CX3,COLUMNS('Open Positions --->'!$CD$3:CE3)),"")

basically Column C doesn't update these values unless I physcially click on a cell in column B and type 1 or 2 then click enter. That number 1 or 2 will enter inclumn C along with anynew number form the formulas in Column D etc. As I understand this is because the change references physical changes but calculate would work better but if I just change change to calcualte I get errors everywhere

nb I am alos draggin those formulas down to cater for all of Column D and B.

As for ordering the column C I included a change event to check when column B is updated to run the filter. This seems to work fine but again it is linked to the main body of your code so it onyl happens when I click, click, enter