Preventing Duplicated Data Input from Click Button from one sheet to another

[marlbrarian]

Hi there,
Old thread I know, I'm having a little bit of trouble getting something to work.
I'm also a bit of a novice, I'll admit.

I'm trying to Populate a table, this I've succeeded in.
Now however I need the information in a specific cell to be read and held against a portion of my table to ensure its not a duplicate.

Read from
Worksheet - Input
Cell C3

Compare to
Worksheet - Database
Tablename - FixDataBase
Column 1 (A), the column name is 'Suffix'

If a match is found I need an error message to be thrown up and the data for the table not to be put in.
(Also for the Cells not to be cleared, which they currently are at the end of the program.

I was attempting to modify the code above for my purpose but i couldn't get it working.
Any help would be greatly appreciated.

Private Sub insertTAB_Click()
'change test to uppercase
Dim mycell As Range
Dim myrange As Range
'---------------------------
'Add Data into FixDataBase
Dim myRow As ListRow
Dim intRows As Integer
'---------------------------
 'Prevent Duplicate Definitions here


        
        
    
'---------------------------
'change text to uppercase
Set myrange = ActiveWorkbook.Worksheets("Input").Range("C3:C4")
            
For Each mycell In myrange
mycell.Value = UCase(mycell.Value)
 Next mycell
        
Set myrange = ActiveWorkbook.Worksheets("Input").Range("C8:C17")
                                    
For Each mycell In myrange
mycell.Value = UCase(mycell.Value)
 Next mycell
'---------------------------
                            
'Prevent Duplicate Code here
                                
                
           
        
        
'---------------------------
'Add Data into FixDataBase
intRows = ActiveWorkbook.Worksheets("Database").ListObjects("FixDataBase").ListRows.Count
Set myRow = ActiveWorkbook.Worksheets("Database").ListObjects("FixDataBase").ListRows.Add(intRows)
    
myRow.Range(1) = Range("C3")
myRow.Range(2) = Range("C4")
myRow.Range(3) = Range("C5")
myRow.Range(4) = Range("C6")
myRow.Range(5) = Range("C8")
myRow.Range(6) = Range("C9")
myRow.Range(7) = Range("C13")
myRow.Range(8) = Range("C12")
myRow.Range(9) = Range("C17")
myRow.Range(10) = Range("C16")
        

'Clear Cell Contents on Completion of input
Range("C3:C17").Clear
            
             
    
    
End Sub

 

[marlbrarian]

Apologies,
The code and thread I'm referring to is here,

Using VBA code to prevent a button from making duplicate entries

Thanks again

 

[dmt32]

Hi,
only just seen this post did you manage to resolve?

Dave

 

[marlbrarian]

Hi,
only just seen this post did you manage to resolve?

Dave

Good Morning Dave,
Sadly not yet. I had another go, and internet trawl but couldn’t sus it out myself. Ran out of time to finish it off, and haven’t revisited it yet. I was going to have another stab at it soon.
Any ideas, would be greatly appreciated.
Sam

 

[dmt32]

Any ideas, would be greatly appreciated.

Try

Sub insertTAB_Click()
    Dim i           As Long
    Dim tblDatabase As ListObject
    Dim myrow       As ListRow
    Dim m           As Variant
    Dim Search      As String
    Dim myrange     As Range, cell As Range
    
    With ThisWorkbook
        Set tblDatabase = .Worksheets("Database").ListObjects("FixDataBase")
        'data entry input range
        Set myrange = .Worksheets("Input").Range("C3:C17")
    End With
    
    'duplicate search value
    Search = myrange.Cells(1, 1).Value
    If Len(Search) = 0 Then Exit Sub
    
    'check for existing record
    m = Application.Match(Search, tblDatabase.Range.Columns(1), 0)
    
    If IsError(m) Then
        'add new record
        Set myrow = tblDatabase.ListRows.Add(AlwaysInsert:=True)
        
        For Each cell In myrange.Cells
            i = i + 1
            myrow.Range(i) = UCase(cell.Value)
        Next cell
        
        'Clear Cell Contents on Completion of input
        myrange.ClearContents
        
        MsgBox Search & Chr(10) & "New Record Added To Database", 64, "New Record"
        
    Else
        'duplicate - inform user
        MsgBox Search & Chr(10) & "Value already exists", 48, "Duplicate"
        
    End If
    
End Sub

Dave

 

[marlbrarian]

Try

Sub insertTAB_Click()
    Dim i           As Long
    Dim tblDatabase As ListObject
    Dim myrow       As ListRow
    Dim m           As Variant
    Dim Search      As String
    Dim myrange     As Range, cell As Range
   
    With ThisWorkbook
        Set tblDatabase = .Worksheets("Database").ListObjects("FixDataBase")
        'data entry input range
        Set myrange = .Worksheets("Input").Range("C3:C17")
    End With
   
    'duplicate search value
    Search = myrange.Cells(1, 1).Value
    If Len(Search) = 0 Then Exit Sub
   
    'check for existing record
    m = Application.Match(Search, tblDatabase.Range.Columns(1), 0)
   
    If IsError(m) Then
        'add new record
        Set myrow = tblDatabase.ListRows.Add(AlwaysInsert:=True)
       
        For Each cell In myrange.Cells
            i = i + 1
            myrow.Range(i) = UCase(cell.Value)
        Next cell
       
        'Clear Cell Contents on Completion of input
        myrange.ClearContents
       
        MsgBox Search & Chr(10) & "New Record Added To Database", 64, "New Record"
       
    Else
        'duplicate - inform user
        MsgBox Search & Chr(10) & "Value already exists", 48, "Duplicate"
       
    End If
   
End Sub

Dave

Your a diamond!
I’ll splice it in and give it a bash and let you know.
Thank you very much.

 

[marlbrarian]

Try

Sub insertTAB_Click()
    Dim i           As Long
    Dim tblDatabase As ListObject
    Dim myrow       As ListRow
    Dim m           As Variant
    Dim Search      As String
    Dim myrange     As Range, cell As Range
   
    With ThisWorkbook
        Set tblDatabase = .Worksheets("Database").ListObjects("FixDataBase")
        'data entry input range
        Set myrange = .Worksheets("Input").Range("C3:C17")
    End With
   
    'duplicate search value
    Search = myrange.Cells(1, 1).Value
    If Len(Search) = 0 Then Exit Sub
   
    'check for existing record
    m = Application.Match(Search, tblDatabase.Range.Columns(1), 0)
   
    If IsError(m) Then
        'add new record
        Set myrow = tblDatabase.ListRows.Add(AlwaysInsert:=True)
       
        For Each cell In myrange.Cells
            i = i + 1
            myrow.Range(i) = UCase(cell.Value)
        Next cell
       
        'Clear Cell Contents on Completion of input
        myrange.ClearContents
       
        MsgBox Search & Chr(10) & "New Record Added To Database", 64, "New Record"
       
    Else
        'duplicate - inform user
        MsgBox Search & Chr(10) & "Value already exists", 48, "Duplicate"
       
    End If
   
End Sub

Dave

Morning Dave!!
Just want to say thank you for your help, works a dream.
Very much appreciate your help.
All the best

 

[dmt32]

Morning Dave!!
Just want to say thank you for your help, works a dream.
Very much appreciate your help.
All the best

most welcome & really appreciate your kind & generous feedback

Dave