Assist in creating loop w/ multi-variables

[YellowLabPro]

I have a relative formula that creates an item record# on the fly. One of the major flaws is that if two products are similar, the newly created item record# could and do create duplicate item record#s.
To resolve this I manually have to enter a unique character or increase one of the ranges to change the record #.
I would like to change my approach slightly and loop through this column and do this on the fly.
I have an idea of how to setup the intial loop, but changing the value is my hang-up.
For Each....Next to loop through and alter the duplicate item record, or
Do Until, to loop through until the immediate item record does not match.
Either one- conceptually I can see, but that is my limit....

Formula & resides in column W, this particular record is W106.
=SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITU TE(F106&LEFT(P106,1)&(LEFT(I106,2)&LEFT(J106,1)&LEFT(M106,2)&LEFT(K106,1)&L EFT(R106,1)&LEFT(O106,2)&LEFT(N106,2)&LEFT(Q106,2)&RIGHT(U106,4)),".",""),"/","")," ",""),"'",""),"""",""),"-",""),"MM","")

IF =Offset(W106,-1) Then
Change Left(I106,2) to Left(I106,2)+1, which would then result in Left(I106,3).
I don't know yet how to go through and establish the variables necessary for something like this.

Thanks,
YLP

[YellowLabPro]

Mistake Response;

[mdmackillop]

I though I had the sheet with this unique formula in it, but I can't find it. Can you post a small extract?

[YellowLabPro]

Hi Md,
Sure here you go...

[Bob Phillips]

Doug,

Why are you using that complex SUBSTITUTE and not just C3?

Also, you don't need CONCATENATE and &, either =CONCATENATE(A1&B1), or =A1&B1.

Finally, is your surname Stroud?

[mdmackillop]

Hi Bob,
C3 depends on W3

[Bob Phillips]

Okay, I get it.

It is incredibly hard work though, even scrolling takes ages. Not a good design.

[YellowLabPro]

Hi xld,
Yes, the scrolling is frustrating. I don't know what the cause of that is. I have been searching for that for sometime.
If you have a better solution to the design, I am open. There are very specific reasons for the way that this is setup.
Yes, my surname is Stroud.

YLP

[royUK]

This has also been posted here;

http://www.ozgrid.com/forum/showthread.php?t=67242

[YellowLabPro]

Roy,
I just read your post, these are two different questions/ and needs. It may look the same, but is completely different. I was looking for help on Ozgrid w/ a formula solution to create an item record# that could handle adding a fractional number to the record.

The post here is requesting help for creating a loop to locate duplicate item records. The formulas are the same in both forums, but they are there for two very different reasons. I hope this is not considered cross-posting, I apologize if it is.

YLP

[rbrhodes]

Hi YLB,

Two different questions. Yup.

For the scrolling problem: Insert a sheet in your workbook. Click in the blank cell at the top left corner of the sheet, between 'A' and '1' to select all the cells in your Sheet "Record Creator". Click 'Copy'. Change to the new sheet. Click 'PasteSpecial' and select 'All'. Delete the original sheet "Record Creator" and rename the new sheet "Record Creator". Set the zoom to 70% to match your example. Save the sheet.

Note: Don't use "Move or Copy a Sheet'. Do as above.

Worked for me.

And for your incrementing part numbers:

Try this one on a COPY of your workbook;

Option Explicit
Sub KillTheDupes()
Dim Cel As Range
Dim LastRow As Long
Dim Iposition As Long
Dim OldFormula As String
Dim NewFormula As String
    'errors?
    'On Error GoTo endo
    'speed
    Application.ScreenUpdating = False
    
    'get last row data
    LastRow = Range("W65536").End(xlUp).Row
    'check all
    For Each Cel In Range("W3:W" & LastRow)
        'test for blank
        If Cel = "" Then GoTo nextcel
        'if match do stuff to change it
        If Cel = Cel.Offset(1, 0) Then
            'get old formula
            OldFormula = Cel.Offset(1, 0).Formula
            'find 'LEFT(I##' in formula USING (I
            Iposition = InStr(OldFormula, "(I")
            'Check the number of digits in the row number, increment
            ' the 'I' string and then concat formula back together, place it
            If Cel.Row + 1 < 10 Then
                'if we're row 9 or less
                NewFormula = Left(OldFormula, Iposition + 3) & _
                                Mid(OldFormula, Iposition + 4, 1) + 1 & _
                                    Right(OldFormula, Len(OldFormula) - (Iposition + 4))
                'put revised fromula in cell
                Cel.Offset(1, 0).Formula = NewFormula
            ElseIf Cel.Row + 1 < 100 Then
                'if we're in row 10 to 99
                NewFormula = Left(OldFormula, Iposition + 4) & _
                                Mid(OldFormula, Iposition + 5, 1) + 1 & _
                                    Right(OldFormula, Len(OldFormula) - (Iposition + 5))
                Cel.Offset(1, 0).Formula = NewFormula
            ElseIf Cel.Row + 1 < 1000 Then
                'if we're in row 100 to 999
                NewFormula = Left(OldFormula, Iposition + 5) & _
                                Mid(OldFormula, Iposition + 6, 1) + 1 & _
                                    Right(OldFormula, Len(OldFormula) - (Iposition + 6))
                Cel.Offset(1, 0).Formula = NewFormula
            'ElseIf
                'if we're in row 1000 to 9999
                    '....etc...
            End If
        End If
nextcel:
    Next Cel
    
    'reset
    Application.ScreenUpdating = True
Exit Sub
endo:
    'reset
    Application.ScreenUpdating = True
    
End Sub

I also posted some suggestions at Oz, re the Subsitute code. Now that I've seen the sheet tho perhaps some VBA to create the part numbers 'on the fly' might be better.

Cheers,

dr

[YellowLabPro]

Rb,
Thanks! Worked great! That thing was killing me forever, or at least the past year.

For the scrolling problem: Insert a sheet in your workbook. Click in the blank cell at the top left corner of the sheet, between 'A' and '1' to select all the cells in your Sheet "Record Creator". Click 'Copy'. Change to the new sheet. Click 'PasteSpecial' and select 'All'. Delete the original sheet "Record Creator" and rename the new sheet "Record Creator". Set the zoom to 70% to match your example. Save the sheet.

[YellowLabPro]

Rb-
[VBA]
The program errored w/ Type 13 Mismatch here:
NewFormula = Left(OldFormula, Iposition + 5) & _
Mid(OldFormula, Iposition + 6, 1) + 1 & _
Right(OldFormula, Len(OldFormula) - (Iposition + 6))
[/VBA]

[mdmackillop]

Hi RB
Nice solution, but with a small glitch.
Where you have a group of identical values, your code will change alternate items, which causes the conditional formatting to clear, but leaves duplicates HA1CIHBK025 HA1CIHBK7 HA1CINHBK7 HA1CIHBK7 HA1CIRHBK7 HA1CIHBK7 AL1BETBLSM
I would suggest checking from the bottom. How you increment for Test = 4 etc., I'll leave to you and Doug to resolve. Personally, I would pass the parameters to another function to handle; keeping code in discrete lumps makes it easier to handle and comprehend.
[vba]
Dim i As Long
For i = LastRow To 3 Step -1
Set Cel = Range("W" & i)
'test for blank
If Cel = "" Then GoTo nextcel
'if match do stuff to change it
Dim test As Long
test = Application.WorksheetFunction.CountIf(Range(Cells(3, 23), Cel.Offset(-1)), Cel.Value)
If test > 0 Then
[/vba]

[YellowLabPro]

Rbrhodes,
Additional details regarding the scroll issue:
Scrolling- I did not include macro assigned buttons in the example workbook, I was deleting everything not necessary to reduce the file to the board's permissible size. These buttons reside in the area of row1 to the left of the sheet. Following your solution, after placing the buttons in the newly created sheet, the sheet began dragging more and more after each open and close of the workbook.
So I followed the same instructions, but now placed the buttons all the way to the right of the information on the sheet.
This appears to solve. Again Thanks for the help here.


YLP