CODEWITHSUNDEEP
excelvba
NotACoderNoah
NotACoderNoah

Reputation: 5

Add user entry if not a duplicate

The goal of this code is to accept a user input number (New_Project_Number) then read down a list (column A3 to last row of the column) compare the numbers and check for duplicates. Then paste the New_Project_Number to the last row of column "A".

Sub Project_Number_Standerdization()

Dim New_Project_Number As Variant
Dim Used_Project_Number As Variant
Dim Last_Pn As Integer 'this is a looping variable for the last row in column a
Dim wss As Worksheet
Dim ii As Integer

New_Project_Number = Application.InputBox("What is the New Project Number?", Type:=1)
Set wss = ActiveSheet
Last_Pn = wss.Range("A3").End(xlDown)


For ii = 1 To Last_Pn

Used_Project_Number = wss.Range("A3").Offset(ii - 1, 0).Value

If New_Project_Number = Used_Project_Number _
Then MsgBox ("That project number is being used please choose a different one.") _
Next ii 

End Sub

This checks for dupes however will not post the code to the bottom. If I add

Else wss.range("A3").end(Xldown).offset(1,0)

right after the then statement and right before

Next ii

Then an error message appears

"else without if statement"

How can I check all used Project Numbers then write the New project number on the last cell. Right now this only checks for dupes.

Upvotes: 0

Views: 116

Answers (1)

Tim Williams
Tim Williams

Reputation: 166341

Using Match() would be faster and no need to loop:

Sub ProjectNumberStandardization()

    Dim New_Project_Number As Variant
    Dim m As Variant
    Dim wss As Worksheet
    
    Set wss = ActiveSheet
    
    New_Project_Number = Application.InputBox("What is the New Project Number?", Type:=1)
    m = Application.Match(New_Project_Number, wss.Columns("A"), 0)
    
    If IsError(m) Then 'no existing match?
        'add the number to the next empty cell at the bottom (xlUp is safer than xlDown)
        wss.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Value = New_Project_Number
    Else
        MsgBox "That project number is being used please choose a different one."
    End If
    
End Sub

Upvotes: 2

Related Questions