Help!!!!!! - Need macro or formula to set customer codes.
Hi,
Actually I have large amount of data of different customers.Some customers having a different code but they are related with one code.
So, I want to give them a new code on the basis of previous code and their name.
I am comparing their previous code first, then their first two names for giving them new code.
I am attaching my sheet herewith. As per my sheet in first case(D4:D9) code is different like DAB126, DHR 134 for same customer 'AB Mart' so I have selected AB as new code same as in second case. But in third case system generated customer code is common so I have selected ADB129 as new code.
My first preference is system generated code if it matches then code is selected as new code if not then I have to compare first two words of customer name and then first word of customer name is selected as new code.
| Attachment | Size |
|---|---|
| 1.xlsx | 10.84 KB |
Expect Reply
i am expecting your reply
Create New Code
So far no one has replied. Hence, my code:
Private Sub cmdCreateNewCode_Click()
'http://excelexperts.com/help-need-macro-or-formula-set-customer-codes
Dim CodNamOne As String
Dim CodOne As String
Dim NamOne As String
Dim NamOneA As String
Dim CodNamTwo As String
Dim CodTwo As String
Dim NamTwo As String
Dim NamTwoA As String
Dim NamOldRowNum As Long
Dim NamNewRowNum As Long
Dim CodNewRowNum As Long
Sheets("1").Select
Range("d4").Select
Do Until Selection.Value = ""
NamOldRowNum = ActiveCell.Row 'First row of One Customer
CodNamOne = Trim(Selection.Value) 'DAB126-AB MART P.LTD-AU
CodOne = Left(CodNamOne, InStr(CodNamOne, "-") - 1) 'DAB126
NamOne = Mid(CodNamOne, InStr(CodNamOne, "-") + 1, Len(CodNamOne)) 'AB MART P.LTD-AU
NamOneA = Left(NamOne, InStr(NamOne, " ") - 1) 'AB
Selection.Offset(1, 0).Select
Do Until Selection.Value = ""
CodNamTwo = Trim(Selection.Value) 'DHR134-AB MART P.LTD-PA
NamTwo = Mid(CodNamTwo, InStr(CodNamTwo, "-") + 1, Len(CodNamTwo)) 'AB MART P.LTD-PA
NamTwoA = Left(NamTwo, InStr(NamTwo, " ") - 1) 'AB
If NamTwoA = NamOneA Then 'AB AB
Selection.Offset(1, 0).Select
Else
NamNewRowNum = ActiveCell.Row - 1 'Last row of One Customer
Exit Do
End If 'NamTwoA = NamOneA
Loop 'Until Selection.Value = ""
If NamNewRowNum < NamOldRowNum Then
NamNewRowNum = ActiveCell.Row - 1 'Last row of One Customer
End If
Range("d" & Trim(Str(NamOldRowNum + 1))).Select 'First row of One Customer
Do Until ActiveCell.Row > NamNewRowNum 'Until last row of One Customer
CodNamTwo = Trim(Selection.Value) 'DHR134-AB MART P.LTD-PA
CodTwo = Left(CodNamTwo, InStr(CodNamTwo, "-") - 1) 'DHR134
If CodTwo = CodOne Then 'DAB126 DAB126
Selection.Offset(1, 0).Select
Else 'DAB126 DHR134 ??
CodNewRowNum = ActiveCell.Row - 1 'Last row of matching code
Exit Do
End If 'CodTwo = CodOne
Loop 'Until ActiveCell.Row > NamNewRowNum
If ActiveCell.Row = NamNewRowNum + 1 Then 'All Codes matched
Range("d" & Trim(Str(NamOldRowNum))).Select
Do Until ActiveCell.Row > NamNewRowNum 'Until last row of matching code
Selection.Offset(0, 3).Value = CodOne 'ADB129 is new code
Selection.Offset(1, 0).Select
Loop 'Until ActiveCell.Row > NamNewRowNum
Else 'All Codes did not match
Range("d" & Trim(Str(NamOldRowNum))).Select
Do Until ActiveCell.Row > NamNewRowNum 'Until last row of matching code
Selection.Offset(0, 3).Value = NamOneA 'AB is new code
Selection.Offset(1, 0).Select
Loop 'Until ActiveCell.Row > NamNewRowNum
End If 'ActiveCell.Row = NamNewRowNum + 1
Loop 'Until Selection.Value = ""
End Sub
Hope this helps. Expecting a feed back.