How to prevent duplicate cells added

user_16618365 0
Viewed 47

I wish to pop up a message box "duplicate item" and not allow the item add when the user adds the same item in cart

Here is my code, but it only works start from 2nd row of the cart:

Sub addcart()
    Dim lastrow As Long
    Dim i As Integer, j As Integer, m As Integer
    Dim x As Variant
    lastrow = Sheets("Sales Point").Range("F" & Rows.Count).End(xlUp).Row
    x = Cells(lastrow, 7).Offset(-1, 0).Value
    If Range("C3").Value = "Please Select Option" Then
        MsgBox "Please Select Option!"
    Else
        If Range("C6").Value = "Please Enter a Quantity" Then
            MsgBox "Please Enter a Quantity!"
        Else
            If x = Cells(lastrow, 7) Then
                MsgBox "Duplicate Entry!"
                
            Else
                For i = 5 To lastrow + 1
                    Cells(i, 5).Value = i - 4
                Next
                    
                Cells(lastrow + 1, 6) = Range("C4")
                Cells(lastrow + 1, 7) = Range("C3")
                Cells(lastrow + 1, 8) = Range("C6")
                Cells(lastrow + 1, 9) = Format(Range("C5"), "Currency")
                Cells(lastrow + 1, 10) = Format(Cells(lastrow + 1, 9) * Cells(lastrow + 1, 8), "Currency")
                    
                For m = 1 To 4
                    For j = 0 To 5
                        Range("E" & Rows.Count).End(xlUp).Offset(0, j).Font.Bold = False
                        Range("E" & Rows.Count).End(xlUp).Offset(0, j).Borders().LineStyle = xlNone
                        Range("E" & Rows.Count).End(xlUp).Offset(m, j).Clear
                    Next j
                Next m
            End If
        End If
    End If
    Worksheets("Sales Point").Columns("E:J").HorizontalAlignment = xlCenter
  
End Sub

This is how my worksheet looks like

enter image description here

vba excel
1 Answers

This is a very basic example which will get you started.

I have commented the code so that you will not have a problem understanding it.

Option Explicit

Sub Sample()
    Dim ws As Worksheet
    Dim LRow As Long
    Dim rng As Range
    Dim aCell As Range
    
    Dim ItmName As String
    Dim ItmCode As String
    Dim Qty As Long
    Dim UnitPrice As Long
    
    '~~> This is your sheet
    Set ws = Sheets("Sales Point")

    With ws
        '~~> Find last row in Col F
        LRow = .Range("F" & .Rows.Count).End(xlUp).Row
        
        '~~> This is your range where we will check for duplicates
        '~~> This column is where the item name is entered
        Set rng = .Range("G5:G" & LRow)
        
        '~~> We pick the new item name from cell C3
        ItmName = .Range("C3").Value2
        '~~> We pick the new item code from cell C4
        ItmCode = .Range("C4").Value2
        '~~> We pick the new unit price from cell C5
        UnitPrice = .Range("C5").Value2
        '~~> We pick the new qty from cell C6
        Qty = .Range("C6").Value2
        
        '~~> Check if there is already that item in the range
        Set aCell = rng.Find(What:=ItmName, LookIn:=xlFormulas, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
        
        '~~> If found
        If Not aCell Is Nothing Then
            MsgBox "The item " & ItmName & " already exists"
        Else
            '~~> If not found then add the new item
            .Range("E" & LRow + 1).Value = LRow - 4
            .Range("F" & LRow + 1).Value = ItmCode
            .Range("G" & LRow + 1).Value = ItmName
            .Range("H" & LRow + 1).Value = Qty
            .Range("I" & LRow + 1).Value = UnitPrice
        End If
    End With
End Sub
user_11405790
Related