Re: userform stopping duplication

Tech Tip: Click here to run a free scan for Windows Errors and optimize PC performance

From: ~Alan (methane_at_adelphia.net)
Date: 05/13/04 

Date: Thu, 13 May 2004 17:15:43 -0400

This is the code verbatem,
  it lets me know that it is a duplicate, and it also duplicates it in
***(parts).
  is there a code I can put in ***(parts) that will stop from
duplicating any item
Also the only way I can get this code to work is to 'txtPart.SetFocus.
 I am not sure what txtPart.SetFocus does could this be me problem?
    
Private Sub cmdAdd_Click()
Dim r As Long
Dim ws As Work***
Set ws = Worksheets("Parts")
With ws
  If .AutoFilterMode Then
    If .FilterMode Then
      .ShowAllData
    End If
  End If
End With
If Application.CountIf(ws.Range("a:a"), txtPartnumber.Value) > 0 Then
  'don't do it, it's already there
  Beep
  MsgBox "Duplicate"
Else
  'do all your assignments
End If
r = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ws.Range("A" & r).Value = txtPartnumber.Value
ws.Range("B" & r).Value = txtQty.Value
ws.Range("C" & r).Value = txtdescription.Value
ws.Range("d" & r).Value = txtmanufacture.Value
ws.Range("E" & r).Value = txtprice.Value
ws.Range("F" & r).Value = txtunits.Value
With Worksheets("sheet2")
  .Cells(.Rows.Count, "DR").End(xlUp).Offset(1, 0).Value _
    = txtPartnumber.Value
End With
txtPartnumber.Value = ""
txtQty.Value = ""
txtdescription.Value = ""
txtmanufacture.Value = ""
txtprice.Value = ""
txtunits.Value = ""
'txtPart.SetFocus

End Sub

Dave Peterson wrote:
>
> When you used this kind of code:
>
> did you put all your assignments in the ELSE portion?
>
> (and you can remove the msgbox when you're done testing)
>
> Private Sub cmdAdd_Click()
> Dim r As Long
> Dim ws As Work***
> Set ws = Worksheets("Parts")
> With ws
> If .AutoFilterMode Then
> If .FilterMode Then
> .ShowAllData
> End If
> End If
> End With
>
> if application.countif(ws.range("a:a"),txtpartnumber.value) > 0 then
> 'don't do it, it's already there
> beep
> 'msgbox "Duplicate"
> else
> 'do all your assignments
> r = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
> ws.Range("A" & r).Value = txtPartnumber.Value
> ws.Range("B" & r).Value = txtQty.Value
> ws.Range("C" & r).Value = txtdescription.Value
> ws.Range("d" & r).Value = txtmanufacture.Value
> ws.Range("E" & r).Value = txtprice.Value
> ws.Range("F" & r).Value = txtunits.Value
> txtPartnumber.Value = ""
> txtQty.Value = ""
> txtdescription.Value = ""
> txtmanufacture.Value = ""
> txtprice.Value = ""
> txtunits.Value = ""
> txtParts.SetFocus
> end if
> End Sub
>
> I'm not sure when you want to update the userform.
>
> maybe
> Private Sub cmdAdd_Click()
> Dim r As Long
> Dim ws As Work***
> Set ws = Worksheets("Parts")
> With ws
> If .AutoFilterMode Then
> If .FilterMode Then
> .ShowAllData
> End If
> End If
> End With
>
> if application.countif(ws.range("a:a"),txtpartnumber.value) > 0 then
> 'don't do it, it's already there
> beep
> 'msgbox "Duplicate"
> else
> 'do all your assignments
> r = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
> ws.Range("A" & r).Value = txtPartnumber.Value
> ws.Range("B" & r).Value = txtQty.Value
> ws.Range("C" & r).Value = txtdescription.Value
> ws.Range("d" & r).Value = txtmanufacture.Value
> ws.Range("E" & r).Value = txtprice.Value
> ws.Range("F" & r).Value = txtunits.Value
> end if
>
> txtPartnumber.Value = ""
> txtQty.Value = ""
> txtdescription.Value = ""
> txtmanufacture.Value = ""
> txtprice.Value = ""
> txtunits.Value = ""
> txtParts.SetFocus
>
> End Sub
>
> ~Alan wrote:
> >
> > When i enter a Duplicate character it gives me the message "Duplicate"
> > and also Duplicates
> > the characters
> > Question how do I stop it from duplicating the characters
> >
> > Dave Peterson wrote:
> > >
> > > if application.countif(ws.range("a:a"),txtpartnumber.value) > 0 then
> > > 'don't do it, it's already there
> > > beep
> > > msgbox "Duplicate"
> > > else
> > > 'do all your assignments
> > > end if
> > >
> > > (what out for typos!)
> > >
> > > ~Alan wrote:
> > > >
> > > > XL2000 userform
> > > > is there something I can add to this code that will stop duplication of
> > > > an item.
> > > >
> > > > Private Sub cmdAdd_Click()
> > > > Dim r As Long
> > > > Dim ws As Work***
> > > > Set ws = Worksheets("Parts")
> > > > With ws
> > > > If .AutoFilterMode Then
> > > > If .FilterMode Then
> > > > .ShowAllData
> > > > End If
> > > > End If
> > > > End With
> > > > r = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
> > > > ws.Range("A" & r).Value = txtPartnumber.Value
> > > > ws.Range("B" & r).Value = txtQty.Value
> > > > ws.Range("C" & r).Value = txtdescription.Value
> > > > ws.Range("d" & r).Value = txtmanufacture.Value
> > > > ws.Range("E" & r).Value = txtprice.Value
> > > > ws.Range("F" & r).Value = txtunits.Value
> > > > txtPartnumber.Value = ""
> > > > txtQty.Value = ""
> > > > txtdescription.Value = ""
> > > > txtmanufacture.Value = ""
> > > > txtprice.Value = ""
> > > > txtunits.Value = ""
> > > > txtParts.SetFocus
> > > > End Sub
> > >
> > > --
> > >
> > > Dave Peterson
> > > ec35720@msn.com
>
> --
>
> Dave Peterson
> ec35720@msn.com

Quantcast