Find Methode eindeutige Werte nicht automatisch in Spalte

Question

Ich habe die Find-Methode verwendet, um zwei Spalten (A und B) in verschiedenen Blättern zu vergleichen. Spalte A ist die aktualisierte Spalte, Spalte B ist die kopierte Spalte. Der Code durchläuft und spaltet die Spalten und sucht nach Übereinstimmungsfällen. Wenn es einen eindeutigen Wert in Spalte A gibt, wird es in Spalte B kopiert. Ich habe es geschafft, es zu codieren, aber der eindeutige Wert erscheint nicht automatisch in Spalte B. Nur wenn ich auf die Zelle mit dem eindeutigen Wert von Spalte A klicke, würde es dann in Spalte B kopiert werden.

Weiß jemand, warum es nicht automatisch aktualisieren kann?

-Code in Spalte A:

Private Sub Worksheet_SelectionChange(ByVal target As Range) 
If target.Column = 9 Then 
fabric = ActiveCell.Value 
Module4.ChkFabric (fabric) 
End If 

End Sub 

Ich habe ein Modul zu kopieren Spalte B verwendet:

Sub ChkFabric(ByRef fabric As String) 
Dim Rng, TgtC, ResC As Range 
Dim PrePlan As Worksheet 

Set PrePlan = Worksheets("Pre Master Plan") 

With PrePlan 
Set ResC = .Range("A:A") 
endrow = .Cells(PrePlan.Rows.Count, "A").End(xlUp).Row 
End With 
With ResC 
Set Rng = .Find(what:=Trim(fabric), LookIn:=xlValues, lookat:=xlWhole, 
searchorder:=xlByRows, searchdirection:=xlNext, _ 
      MatchCase:=False) 
If Not Rng Is Nothing Then 


Else 
    PrePlan.Cells(endrow + 1, 1) = fabric 
End If 
End With 


End Sub 

Answer 1

ich ein Stück Code geschrieben Eindeutiger Wert zu holen (nicht enthalten sind Artikel wenn es Duplikate hat) von einer Spalte und in eine andere schreiben

Sub uniq() 
Dim cntOccur As Integer 
Dim rowCount As Integer 
Dim Checkcol As Integer, Targetcol As Integer 
Dim currentRowValue As String 
Dim currentRow As Integer, brow As Integer 
Checkcol = 1 'Denotes A column 
Targetcol = 2 'Denotes B column 

rowCount = Cells(Rows.Count, Checkcol).End(xlUp).Row 
brow = 0 
    For currentRow = 1 To rowCount 
     currentRowValue = Cells(currentRow, Checkcol).Value 
' Check the number of occurrence of each and every cell in column A 
     cntOccur = Application.WorksheetFunction.CountIf(Range("A1:A" & rowCount), currentRowValue) 
If cntOccur = 1 Then 
brow = brow + 1 
' If it is unique and has no duplicates then write in to B 
Cells(brow, Targetcol).Value = currentRowValue 
End If 

Next 
End Sub