Add unique value automatically to sheets("to.") and sheets("total")

hi, everyone

i have three worksheets on my workbook
1 = "TO."
2 = "ENTRY"
3 = "TOTAL"

I add data sheets("entry").range("c10:c300"). so when i add data here then automatically add same but unique to sheets("to.").range("b4:b100") and sheets("total").range("c4"c100")

for example
i add "haroon" in range sheets("entry").range("c10:c300")

then "haroon" auto add to sheets("to.") and sheets("total") in range

if "haroon" already added in sheets("to.") and sheets("total") then ignore it


I Think this will done with worksheet_change event

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.count > 1 Then Exit Sub
If Target = "" Then Exit Sub
If Not Intersect(Target, Range("C10:C500")) Is Nothing Then
and code here....
End Sub

thanx a lot

Done it in 2 different ways so you can choose.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    If Target = vbNullString Then Exit Sub
    If Not Intersect(Target, Range("C10:C500")) Is Nothing Then
        With Sheets("TO.")
            If IsError(Application.Match(Target.Value, .Columns(2), 0)) Then
                .Range("B" & .Rows.CountLarge).End(xlUp).Offset(1) = Target.Value
            End If
        End With
        With Sheets("TOTAL")
            If Application.CountIf(.Columns(3), Target.Value) = 0 Then
                .Range("C" & .Rows.CountLarge).End(xlUp).Offset(1) = Target.Value
            End If
        End With
    End If
End Sub

Thank you Forum Expert once again

working perfectly as i wanted

but i have one more question, if i want to use NameRange instead of simple range
i mean

"ABD" for sheets("to.").range("b4:b100")

"ABE" for sheets("total").range("c4"c100")

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng as range
Dim rng1 as range
    If Target.Cells.Count > 1 Then Exit Sub
    If Target = vbNullString Then Exit Sub
    If Not Intersect(Target, Range("C10:C500")) Is Nothing Then
        With Sheets("TO.")
           Set rng =.columns(2).specialcells(2).find(target.value)

If rng is nothing then 
Range("b" & rng.rows.count.offset(1))=target.value
Else
Exit sub
End with
End if
End if
...etc for other sheet
End Sub

Hello daboho,

Please when you are posting any Code ensure you use Code Tags.

Your post does not comply with Rule 3 of our Forum RULES. Use code tags around code.

Posting code between [CODE] [/CODE] tags makes your code much easier to read and copy for testing, it also maintains VBA formatting.

Click on Edit to open your thread, then highlight your code and click the # icon at the top of your post window. More information about these and other tags can be found here

Thank you.

Try this.
Add following code to Standard module.

Function GetBottomLeft(NamedRange As String) As String
    With Range(NamedRange)
        GetBottomLeft = .Cells(1, 1)(.Rows.Count).Address
    End With
End Function

Then in Sheet module.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    If Target = vbNullString Then Exit Sub
    If Not Intersect(Target, Range("C10:C500")) Is Nothing Then
        With Sheets("TO.")
            If IsError(Application.Match(Target.Value, .Range("ABD"), 0)) Then
                .Range(GetBottomLeft("ABD")).End(xlUp).Offset(1) = Target.Value
            End If
        End With
        With Sheets("TOTAL")
            If IsError(Application.Match(Target.Value, .Range("ABE"), 0)) Then
                .Range(GetBottomLeft("ABE")).End(xlUp).Offset(1) = Target.Value
            End If
        End With
    End If
End Sub

Thanx a lot dear bakerman2 once again

its working perfectly



you solved my big problem

You're welcome and thanks for adding rep points. (again )

Hey bakerman2 u deserve better then rep+

btw dear i am getting little problem here

this code is slow. should i use "Application.EnableEvents" here or any other idea?

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    If Target = vbNullString Then Exit Sub
    If Not Intersect(Target, Range("C10:C500")) Is Nothing Then
        With Sheets("TO.")
            If IsError(Application.Match(Target.Value, .Columns(2), 0)) Then
                .Range("B" & .Rows.CountLarge).End(xlUp).Offset(1) = Target.Value
            End If
        End With
        With Sheets("TOTAL")
            If Application.CountIf(.Columns(3), Target.Value) = 0 Then
                .Range("C" & .Rows.CountLarge).End(xlUp).Offset(1) = Target.Value
            End If
        End With
    End If
End Sub

Hey bakerman2 u deserve better then rep+

btw dear i am getting little problem here

this code is slow. should i use "Application.EnableEvents" here or any other idea?

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    If Target = vbNullString Then Exit Sub
    If Not Intersect(Target, Range("C10:C500")) Is Nothing Then
        With Sheets("TO.")
            If IsError(Application.Match(Target.Value, .Columns(2), 0)) Then
                .Range("B" & .Rows.CountLarge).End(xlUp).Offset(1) = Target.Value
            End If
        End With
        With Sheets("TOTAL")
            If Application.CountIf(.Columns(3), Target.Value) = 0 Then
                .Range("C" & .Rows.CountLarge).End(xlUp).Offset(1) = Target.Value
            End If
        End With
    End If
End Sub

If there are a lot of formulas involved you could start by setting calculation to manual at the start. (don't forget to reset at the end)
Also instead of searching entire column you could search in Named Range only. (see Post#6)