Edit to existing working code

I

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
5,689
Office Version
  1. 2007
Platform
  1. Windows
Afternoon,
The current working code is supplied below,

Basically it allows me to keep certain information about my customers with regards their purchase from me.
Currently it works like this.
I enter the new customers name in TextBox 2 like example JOHN SMITH "this is his first purchase"
I complete the other fields and transfer to worksheet.
Lets say next month this same customer makes another purchase from me, the code does not allow two of the same name SO when i enter JOHN SMITH the code automatically adds 002 to his name, So thus JOHN SMITH 002 & so on into the future JOHN SMITH 003 JOHN SMITH 004 for each purchase made etc etc

What this required edit would be is to add 001 after a new customer.
So i type DAVID BECKHAM the codes does not see another match so adds 001, So thus DAVID BECKHAM 001.
Upon the next purchase when i type DAVID BECKHAM the code automatically adds 002 like before.

My worksheet will then have an entire list of customers names followed by 001, 002, 003 etc etc




Code: 
Private Sub PostageSheetTransferButton_Click()Cancel = 0
If TextBox2.Text = "" Then
    Cancel = 1
    MsgBox "Customer`s Name Not Entered", vbCritical, "POSTAGE TRANSFER SHEET"
    TextBox2.SetFocus
ElseIf TextBox3.Text = "" Then
    Cancel = 1
    MsgBox "Item Description Not Entered", vbCritical, "POSTAGE TRANSFER SHEET"
    TextBox3.SetFocus
ElseIf TextBox4.Text = "" Then
    Cancel = 1
    MsgBox "Tracking Number Not Entered", vbCritical, "POSTAGE TRANSFER SHEET"
    TextBox4.SetFocus
ElseIf ComboBox1.Text = "" Then
    Cancel = 1
    MsgBox "Username Not Entered", vbCritical, "POSTAGE TRANSFER SHEET"
    ComboBox1.SetFocus
    
ElseIf OptionButton1.Value = False And OptionButton2.Value = False And OptionButton3.Value = False Then
    Cancel = 1
    MsgBox "You Must Select An Ebay Account", vbCritical, "POSTAGE TRANSFER SHEET"
    
ElseIf OptionButton4.Value = False And OptionButton5.Value = False And OptionButton6.Value = False Then
    Cancel = 1
    MsgBox "You Must Select An Origin", vbCritical, "POSTAGE TRANSFER SHEET"
    
End If


If Cancel = 1 Then
        Exit Sub
End If


Dim i As Long
Dim x As Long
Dim ctrl As Control
Dim lastrow As Long
lastrow = ThisWorkbook.Worksheets("POSTAGE").Cells(Rows.Count, 1).End(xlUp).Row
    


    
 With ThisWorkbook.Worksheets("POSTAGE")
    .Cells(lastrow + 1, 1).Value = TextBox1.Text: TextBox1.Value = ""
    .Cells(lastrow + 1, 2).Value = TextBox2.Text: TextBox2.Value = ""
    .Cells(lastrow + 1, 3).Value = TextBox3.Text: TextBox3.Value = ""
    .Cells(lastrow + 1, 5).Value = TextBox4.Text: TextBox4.Value = ""
    .Cells(lastrow + 1, 9).Value = ComboBox1.Text: ComboBox1.Value = ""
    .Cells(lastrow + 1, 4).Value = TextBox6.Text: TextBox6.Value = ""
    If OptionButton1.Value = True Then .Cells(lastrow + 1, 8).Value = "DR": OptionButton1.Value = False
    If OptionButton2.Value = True Then .Cells(lastrow + 1, 8).Value = "IVY": OptionButton2.Value = False
    If OptionButton3.Value = True Then .Cells(lastrow + 1, 8).Value = "N/A": OptionButton3.Value = False
    If OptionButton4.Value = True Then .Cells(lastrow + 1, 6).Value = "EBAY": OptionButton4.Value = False
    If OptionButton5.Value = True Then .Cells(lastrow + 1, 6).Value = "WEB SITE": OptionButton5.Value = False
    If OptionButton6.Value = True Then .Cells(lastrow + 1, 6).Value = "N/A": OptionButton6.Value = False
    MsgBox "Customer Postage Sheet Updated", vbInformation, "SUCCESSFUL MESSAGE"
End With
TextBox1.Value = Format(CDbl(Date), "dd/mm/yyyy")
TextBox2.SetFocus
TextBox1.Value = Now
TextBox1.Value = Format(CDbl(Date), "dd/mm/yyyy")
End Sub

Many thanks & have a nice day
 

Excel Facts

Can you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"
Sort by date Sort by votes
@ipbr21054

Try making this small edit to your code

Code: 
 With ThisWorkbook.Worksheets("POSTAGE")
    .Cells(lastrow + 1, 1).Value = TextBox1.Text: TextBox1.Value = ""
    .Cells(lastrow + 1, 2).Value = TextBox2.Text[COLOR=#ff0000] & " 001"[/COLOR]: TextBox2.Value = ""
    .Cells(lastrow + 1, 3).Value = TextBox3.Text: TextBox3.Value = ""

That should add 'space001 to the name that is input in TexBox2.
Hopefully whatever additional code you have that is incrementing a plain name to name & 002 etc will not be thrown by your original name now ending in 001?

Hope that helps.
 
Upvote 0
Morning,
Reading your reply above i noticed that i had supplied the wrong code.
Below is the code i believe to be correct where 002 003 etc is added after the customers name so no duplicates are transfered to my worksheet.

With the addition of that extra piece of code in red works in respect of adding the 001 after the name.
So if i type JOHN SMITH & the date is transfered to my worksheet i then see JOHN SMITH 001 which is great.
Then i do this, I type JOHN SMITH again BUT after the transfer i see JOHN SMITH 001 " so now 2 x JOHN SMITH 001on my worksheet"

So the code below i believe needs and edit so like before when i type say JOHN SMITH automatically i see it highlighted blue & it then shows JOHN SMITH 003 etc as JOHN SMITH 001 & JOHN SMITH 002 already exist on my worksheet.
Many thanks




Code: 
Private Sub TextBox2_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)    Dim fndRng As Range, findString As String, i As Integer


If Me.TextBox2.Value = "" Then Exit Sub
findString = Me.TextBox2.Value


With Sheets("POSTAGE").Range("B:B")
    Set fndRng = .Find(What:=findString, LookIn:=xlValues, lookat:=xlWhole, _
                   SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
                   
    If Not fndRng Is Nothing Then
        'what was entered already exists - alter the name until not found
        For i = 2 To 500
            findString = Me.TextBox2.Value & Format(i, " 000")
            
            Set fndRng = .Find(What:=findString, LookIn:=xlValues, lookat:=xlWhole, _
                       SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
            If fndRng Is Nothing Then Exit For
        Next i
        
        'message saying what name should be
        'MsgBox "The name to use is " & findString
        
        'enter that name into textbox 2
        With Me.TextBox2
            .Value = findString
            .SelStart = 0
            .SelLength = Len(.Text)
            .SetFocus
        End With
        
        'cancel moving out of text box
        Cancel = True
    End If
End With
    
End Sub
 
Upvote 0
Ive just noticed this should it help you a little more.

I have an existing customer who has only purchased one time from me so there name on the sheet is ZANE ROONEY
If i type ZANE ROONEY again i see it change automatically to ZANE ROONEY 002 i complete the form & transfer to worksheet.
On my worksheet i now have ZANE ROONEY & ZANE ROONEY 002

If i now type JOHN SMITH complete the form & tranfer i see JOHN SMITH 001 on the worksheet so yet again i type JOHN SMITH " i dont see 002 automatically added" complete the form & transfer BUT im now expecting to see JOHN SMITH 002 but i actually see another JOHN SMITH 001 again.
 
Upvote 0
Hi,
untested but see if this update to your code helps you


Code: 
Private Sub TextBox2_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
    Dim fndRng As Range
    Dim findString As String
    Dim i As Integer
    Dim wsPostage As Worksheet
    
    findString = Me.TextBox2.Value
    If Len(findString) = 0 Then Exit Sub
    
    Set wsPostage = ThisWorkbook.Worksheets("POSTAGE")
    
    Do
        Set fndRng = wsPostage.Range("B:B").Find(What:=IIf(i = 0, findString, findString & Format(i, " 000")), _
                                                    LookIn:=xlValues, lookat:=xlWhole, SearchOrder:=xlByRows, _
                                                    SearchDirection:=xlNext, MatchCase:=False)
        If Not fndRng Is Nothing Then
            i = i + 1
            Me.TextBox2.Value = findString & Format(i, " 000")
            Cancel = True
        End If
        
    Loop Until fndRng Is Nothing
    Cancel = False
    
End Sub

Dave
 
Upvote 0
Hi,
Sorry but that just allows me to duplicate on the worksheet.

Ive almost got it but not quite.
Ive managed to enter a name then transfer.
Changing a digit etc in the code im able to type the same name and when i transfer i see it followed by 001
My problem was that entering the same name again would just add another 001 after the 001
I decided to stop/wait for help from this group.
My goal is this.

Type JOHN SMITH transfer to work sheet as JOHN SMITH 001

Type JOHN SMITH again and transfer to worksheet as JOHN SMITH 002

Type JOHN SMITH again and transfer to worksheet as JOHN SMITH 003

Using my original code with this edit below.
Code: 
[COLOR=#333333].Cells(lastrow + 1, 2).Value = TextBox2.Text[/COLOR][COLOR=#ff0000] & " 001"[/COLOR][COLOR=#333333]: TextBox2.Value = ""[/COLOR]

I type JOHN SMITH on form & see JOHN SMITH 001 on worksheet so far great.

But from then on each time i type JOHN SMITH it just repeats itself by allowing JOHN SMITH 001 to be transfered.

Not sure why the duplicate code does not see that JOHN SMITH 001 is allready on my worksheet & transfer it as JOHSN SMITH 002

My Test
With the same above code in place i type in a name that has purchased before from me.
So in this example i have ZUBER MOOSA ZUBER MOOSA 002 ZUBER MOOSA 003 on my worksheet.
I type in ZUBER MOOSA & straight away on my form i see ZUBER MOOSA 004

Does it have anything to do with this.
Each time the duplicate code runs & checks the existing names on my worksheet should there be an existing name on the sheet the 002 003 004 etc etc is added to the typed name on my form & shown in blue highlight.

When i add a new customers name the 001 is added to the worksheeet AFTER the code that checks for duplicates has run

Currently the duplicate code does not see a match in the worksheet thus allowing me to type JOHN SMITH & nothing else,obviously next time it will see JOHN SMITH and as i type JOHN SMITH it then adds the 002

Can we edit the duplicate code so when a new customer is added it automatically adds the 001 because it thinks JOHN SMITH allready exists in the list,this same code will then add 002 003 etc in the future.
I think the red code above & the duplicate code dont work together.

Sorry for the story
 
Last edited:
Upvote 0
Good Morning,

Try reverting the original code to what it was, without my red edit.

Then edit your other code as below.
Code: 
Private Sub TextBox2_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)

Dim fndRng As Range, findString As String, i As Integer


If Me.TextBox2.Value = "" Then Exit Sub
findString = Me.TextBox2.Value[COLOR=#0000ff] & " 001"[/COLOR]




With Sheets("POSTAGE").Range("B:B")
    Set fndRng = .Find(What:=findString, LookIn:=xlValues, lookat:=xlWhole, _
                   SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
                   
    If Not fndRng Is Nothing Then
        'what was entered already exists - alter the name until not found
        For i = [COLOR=#0000ff]1[/COLOR] To 500
            findString = Me.TextBox2.Value & Format(i, " 000")
            
            Set fndRng = .Find(What:=findString, LookIn:=xlValues, lookat:=xlWhole, _
                       SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
            If fndRng Is Nothing Then Exit For
        Next i
        
        'message saying what name should be
        'MsgBox "The name to use is " & findString
        
        'enter that name into textbox 2
        With Me.TextBox2
            .Value = findString
            .SelStart = 0
            .SelLength = Len(.Text)
            .SetFocus
        End With
        
        'cancel moving out of text box
        Cancel = True
    End If
End With
    
End Sub

Let me know how you get on.
 
Upvote 0
ipbr21054 said:
Hi,

My goal is this.

Type JOHN SMITH transfer to work sheet as JOHN SMITH 001

Type JOHN SMITH again and transfer to worksheet as JOHN SMITH 002

Type JOHN SMITH again and transfer to worksheet as JOHN SMITH 003
Click to expand...


Seems like suggestion is almost there

See if this update helps

Code: 
    Dim fndRng As Range
    Dim findString As String
    Dim i As Integer
    Dim wsPostage As Worksheet
    
    findString = Me.TextBox2.Value
    If Len(findString) = 0 Then Exit Sub
    
    Set wsPostage = ThisWorkbook.Worksheets("POSTAGE")
    i = 1
    Do
        Set fndRng = Nothing
        Set fndRng = wsPostage.Range("B:B").Find(What:=findString & Format(i, " 000"), _
                                                    LookIn:=xlValues, lookat:=xlWhole, SearchOrder:=xlByRows, _
                                                    SearchDirection:=xlNext, MatchCase:=False)
        If Not fndRng Is Nothing Then
            i = i + 1
            Cancel = True
        End If
    Loop Until fndRng Is Nothing
    
    Me.TextBox2.Value = findString & Format(i, " 000")
    Cancel = False
    
End Sub

This code only changes the Text in your Textbox2 to include the suffix you require after you have entered the Name.
You need to check the code that transfers your forms control values to the worksheet to ensure that you are not repeating the process.

Dave
 
Upvote 0
Snakehips said:
Good Morning,

Try reverting the original code to what it was, without my red edit.

Then edit your other code as below.
Code: 
Private Sub TextBox2_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)

Dim fndRng As Range, findString As String, i As Integer


If Me.TextBox2.Value = "" Then Exit Sub
findString = Me.TextBox2.Value[COLOR=#0000ff] & " 001"[/COLOR]




With Sheets("POSTAGE").Range("B:B")
    Set fndRng = .Find(What:=findString, LookIn:=xlValues, lookat:=xlWhole, _
                   SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
                   
    If Not fndRng Is Nothing Then
        'what was entered already exists - alter the name until not found
        For i = [COLOR=#0000ff]1[/COLOR] To 500
            findString = Me.TextBox2.Value & Format(i, " 000")
            
            Set fndRng = .Find(What:=findString, LookIn:=xlValues, lookat:=xlWhole, _
                       SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
            If fndRng Is Nothing Then Exit For
        Next i
        
        'message saying what name should be
        'MsgBox "The name to use is " & findString
        
        'enter that name into textbox 2
        With Me.TextBox2
            .Value = findString
            .SelStart = 0
            .SelLength = Len(.Text)
            .SetFocus
        End With
        
        'cancel moving out of text box
        Cancel = True
    End If
End With
    
End Sub

Let me know how you get on.
Click to expand...


Hi,
This had no affect at all.

I typed a name it transfered.
I typed same name it transfered as above without any 001 002 003 etc

Now trying other post
 
Upvote 0
I can confirm that this works perfect,many thanks.

Code: 
Private Sub TextBox2_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)    Dim fndRng As Range
    Dim findString As String
    Dim i As Integer
    Dim wsPostage As Worksheet
    
    findString = Me.TextBox2.Value
    If Len(findString) = 0 Then Exit Sub
    
    Set wsPostage = ThisWorkbook.Worksheets("POSTAGE")
    i = 1
    Do
        Set fndRng = Nothing
        Set fndRng = wsPostage.Range("B:B").Find(What:=findString & Format(i, " 000"), _
                                                    LookIn:=xlValues, lookat:=xlWhole, SearchOrder:=xlByRows, _
                                                    SearchDirection:=xlNext, MatchCase:=False)
        If Not fndRng Is Nothing Then
            i = i + 1
            Cancel = True
        End If
    Loop Until fndRng Is Nothing
    
    Me.TextBox2.Value = findString & Format(i, " 000")
    Cancel = False
    
End Sub


Now need a little more help please
This will now be a one off press of a button then not used.
Some infor for you.
Worksheet called POSTAGE
Column B
Range B8:B881

I now need to add SPACE 001 to All the name which do not have 002 003 004 etc after them.
My list at present is like

JOHN SMITH
FRED WINTER
FRED WINTER 002
FRED WINTER 003
ETC ETC

So ONLY looking at names like in my example above JOHN SMITH would be changed to JOHN SMITH 001
FRED WINTER would be changed to FRED WINTER 001

So the new list will then start to look like,
JOHN SMITH 001
FRED WINTER 001
FRED WINTER 002
FRED WINTER 003
ETC ETC

This then sorts out my sheet & the new code we have just sorted will take control of starting with the new 001
Otherwise i need to go through my list and manually add the 001 to every names of which is just text.

Names like BOB JONES 002 will not be touched as it has 002 BUT if there is BOB JONES then please add 001 to it

Many Thanks for your time.
Saved me big time.
 
Upvote 0
You must log in or register to reply here.

Similar threads

I
  • Question Question
Advice to remove old code for a new code
Replies
2
Views
192
ipbr21054
I
I
  • Question Question
Use the majority of an existing working code in new project advice
Replies
1
Views
185
ipbr21054
I
K
  • Question Question
I was try to load data To List Box And Transfer data to Sheet2.... (Not work this userform)
Replies
4
Views
154
krunal123
K
J
  • Question Question
Excel VBA Print Name Tag from Userform
Replies
2
Views
326
Rhodie72
Rhodie72
I
  • Question Question
Add ID number next to customer row from userform transfer
Replies
2
Views
303
Joe4
Joe4

Forum statistics

Threads
1,223,164
Messages
6,170,444
Members
452,326
Latest member
johnshaji

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top