Search code examples
excelvbado-loops

vba loop no checking for duplicate part number


I need my loop to check for existing part numbers and only if there is no existing part number to add it to my table. If the part number already exists, to have a message box stating that it already exists. Its adding it to my table just fine, but will not give me the message box if there is already an existing part number.

Private Sub Add_Click()

Dim ws As Worksheet
Set ws = Sheet4
Dim X As Integer
Dim lastrow As Long
Dim PartColumnIndex As Integer
Dim DescriptionColumnIndex As Integer

Const Part = "CM ECP"
Const Description = "Material Description"

Dim PartNum As String
Dim MaterailDescription As String

Dim tbl As ListObject

Set tbl = ws.ListObjects("Master")
Dim newrow As ListRow
Set newrow = tbl.ListRows.Add

With ws
    On Error Resume Next
    Let PartColumnIndex = WorksheetFunction.Match(PartNum, .Rows(2), 0)
    Let DescriptionColumnIndex = WorksheetFunction.Match(MaterialDecription, .Rows(2), 0)
    Let lastrow = .Cells(.Rows.Count, PartColumnIndex).End(xlUp).Row
    
    X = 3
    
    Do
        Let PartValue = .Cells(X, PartColumnIndex).Value
        Let DecriptionColumnIndex = .Cells(X, DecriptionColumnIndex).Value
        If TextBox1.Value = PartValue Then
            MsgBox "Part Number " + TextBox1.Value + " already exists. Please try again or return to main screen."
        ElseIf TextBox1.Value <> PartValue Then
            With newrow
                .Range(1) = TextBox1.Value
                .Range(2) = TextBox2.Value
            End With
        ElseIf X < lastrow Then
            X = X + 1
        
            
        End If
                 
        
    
    Loop Until X > lastrow

    End With

Solution

  • Scan all the rows in the table before deciding to add a new row or not, and always add Use Option Explicit to top of code to catch errors like DecriptionColumnIndex (no s).

    Option Explicit
    
    Sub Add_Click()
    
        Const PART = "CM ECP"
        Const DESCRIPTION = "Material Description"
    
        Dim ws As Worksheet
        Dim X As Integer, lastrow As Long
        Dim PartColumnIndex As Integer, DescrColumnIndex As Integer
        Dim PartNum As String, MaterialDescription As String
        Dim tbl As ListObject, bExists As Boolean
        
        Set ws = Sheet1
        Set tbl = ws.ListObjects("Master")
        With tbl
            
            PartColumnIndex = .ListColumns(PART).Index
            DescrColumnIndex = .ListColumns(DESCRIPTION).Index
            
            PartNum = Trim(TextBox1.Value)
            MaterialDescription = Trim(TextBox2.Value)
            
            ' search
            With .DataBodyRange
                lastrow = .Rows.Count
                For X = 1 To lastrow
                    If .Cells(X, PartColumnIndex).Value = PartNum Then
                        bExists = True
                        Exit For
                    End If
                Next
            End With
            
            ' result
            If bExists = True Then
                MsgBox "Part Number `" & PartNum & "` already exists on Row " & X & vbLf & _
                "Please try again or return to main screen.", vbExclamation
            Else
                With .ListRows.Add
                    .Range(, PartColumnIndex) = PartNum
                    .Range(, DescrColumnIndex) = MaterialDescription
                End With
                MsgBox "Part Number `" & PartNum & "` added", vbInformation
            End If
            
        End With
    End Sub