Home > Software engineering >  vba loop no checking for duplicate part number
vba loop no checking for duplicate part number

Time:11-06

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

CodePudding user response:

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
  • Related