hi dears
i have this file
i want to enter data in sheet 1 and if not existed in "databank" sheet , then copy in data bank sheet and if exist do nothing .
how can i do these?
hi dears
i have this file
i want to enter data in sheet 1 and if not existed in "databank" sheet , then copy in data bank sheet and if exist do nothing .
how can i do these?
Re: Macro to copy data ny if not duplicated
any idea?
Re: Macro to copy data ny if not duplicated
You do not need the button. Try this in the Worksheet Object module for Sheet 1
Private Sub Worksheet_Change(ByVal Target As Range)
Dim x, i As Long
If Target.Count > 1 Then Exit Sub
If Target = "" Then Exit Sub
If Target.Column = 1 Then
Application.EnableEvents = 0
With Sheets("data bank")
If Not IsError(Application.Match(Target, .Columns(1), 0)) Then
If Application.Match(Target, Columns(1), 0) = Target.Row Then
i = Application.Match(Target, .Columns(1), 0)
Target.Offset(, 1).Resize(, 3) = Array(.Cells(i, 2), .Cells(i, 3), .Cells(i, 4))
Else
MsgBox "Data for " & Target & " is already entered.", 64, "Duplicatated Entry."
Target.Select
Target = ""
End If
Else
MsgBox "ID " & Target & " does not exist in Data Bank.", 16, "Invalid Entry."
Target.Select
Target = ""
End If
End With
If Target <> "" Then
With Target.Resize(, 4)
.HorizontalAlignment = -4108
.Borders.Weight = 2
End With
End If
End If
Application.EnableEvents = 1
End Sub
Display More
Any entry in column A of sheet 1 will fire the macro. If entry does not exist in data bank, or if entry is a duplication then there will be a message and the entry will be cleared, otherwise data for entered ID will be added, text will be centered and borders added.
Re: Macro to copy data ny if not duplicated
thanks a million master KJBOX
there is only one thing : i want it to let me enter datas if it not exist in "databank" sheet,only duplications are forbidden
Re: Macro to copy data ny if not duplicated
In that case change the code to this
Private Sub Worksheet_Change(ByVal Target As Range)
Dim x, i As Long
If Target.Count > 1 Then Exit Sub
If Target = "" Then Exit Sub
If Target.Column = 1 Then
Application.EnableEvents = 0
With Sheets("data bank")
If Not IsError(Application.Match(Target, .Columns(1), 0)) Then
If Application.Match(Target, Columns(1), 0) = Target.Row Then
i = Application.Match(Target, .Columns(1), 0)
Target.Offset(, 1).Resize(, 3) = Array(.Cells(i, 2), .Cells(i, 3), .Cells(i, 4))
Else
MsgBox "Data for " & Target & " is already entered.", 64, "Duplicatated Entry."
Target.Select
Target = ""
End If
End If
End With
If Target <> "" Then
With Target.Resize(, 4)
.HorizontalAlignment = -4108
.Borders.Weight = 2
End With
End If
End If
Application.EnableEvents = 1
End Sub
Display More
Re: Macro to copy data ny if not duplicated
thanks bro , but now copy isnt working
Re: Macro to copy data ny if not duplicated
OK, I just re-read your opening post, I think I misunderstood.
Are you wanting to enter data in sheet 2 row 2 and add that data to the data bank sheet as long as the ID does not already exist in the data bank?
Re: Macro to copy data ny if not duplicated
yes
Re: Macro to copy data ny if not duplicated
OK. How does Sheet 1 work? Does it get updated with multiple rows of data or one row at a time?
Does new data on sheet 1 get added to any existing data on that sheet or does new data replace old data?
Re: Macro to copy data ny if not duplicated
i want that when enter data only in range a2 :d2 (sheet 1) , then push a button , this button do this functions:
if ID is exist in "databank" sheet ( column a ) , Prompt me that it s duplicated , so do nothing in "databank" sheet
but if the id is not existed in "databank" sheet
then add new row to existing datas
and so on ...
Re: Macro to copy data ny if not duplicated
OK so only row 2 of Sheet 1 will contain data at any time?
Re: Macro to copy data ny if not duplicated
yes, but this data will be replace every time, but i want to databank sheet keep previous data constantly
Re: Macro to copy data ny if not duplicated
i find this code
is it good?
Sub unique_column()
Dim data() As Variant 'array that will store all of the unique letters
c = 1
Range("A1").Select
Do While ActiveCell.Value <> ""
ReDim Preserve data(1 To c) As Variant
If IsInArray(ActiveCell.Value, data()) = False Then 'we are on a new unique letter and will add it to the array
data(c) = ActiveCell.Value
c = c + 1
End If
ActiveCell.Offset(1, 0).Select
Loop
'now we can spit out the letters in the array into a new column
Range("B1").Value = "Unique letters:"
Dim x As Variant
Range("B2").Select
For Each x In data()
ActiveCell.Value = x
ActiveCell.Offset(1, 0).Select
Next x
Range("A1").Select
c = c - 1
killer = MsgBox("Processing complete!" & vbNewLine & c & "unique letters applied.", vbOKOnly)
End Sub
Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1)
End Function
Display More
Re: Macro to copy data ny if not duplicated
Sorry, I got caught up with a load of other work, I will look at you file and my code again shortly.
Re: Macro to copy data ny if not duplicated
Try the attached, as soon as A2 to D2 has a value entered in each cell then the 4 values will get transferred to the Table on the "data bank" sheet, unless the ID in cell A2 already exists in the data bank.
Code in the Worksheet Object Module for Sheet1 is
Private Sub Worksheet_Change(ByVal Target As Range)
Dim x, i As Long
If Not Intersect(Target, [a2:d2]) Is Nothing Then
If Application.CountA([a2:d2]) < 4 Then Exit Sub
Application.EnableEvents = 0
With Sheets("data bank")
If IsError(Application.Match([a2], .Columns(1), 0)) Then
If IsEmpty(.[a2]) Then
i = 2
Else
i = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
End If
.Cells(i, 1).Resize(, 4) = [a2:d2].Value
Else
MsgBox "Data for " & Target & " is already entered.", 64, "Duplicatated Entry."
End If
End With
[a2].Select
[a2:d2].ClearContents
End If
Application.EnableEvents = 1
End Sub
Display More
Re: Macro to copy data ny if not duplicated
WoWWWWWWWWWWWWWW
thanks a millions :oz:
works like a charm
Re: Macro to copy data ny if not duplicated
You're welcome.
Don’t have an account yet? Register yourself now and be a part of our community!