PDA

View Full Version : Assist in creating loop w/ multi-variables



YellowLabPro
04-14-2007, 07:12 AM
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)&LEFT(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
04-14-2007, 07:19 AM
Mistake Response;

mdmackillop
04-14-2007, 07:25 AM
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
04-14-2007, 07:55 AM
Hi Md,
Sure here you go...

Bob Phillips
04-14-2007, 08:18 AM
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
04-14-2007, 08:25 AM
Hi Bob,
C3 depends on W3

Bob Phillips
04-14-2007, 08:54 AM
Okay, I get it.

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

YellowLabPro
04-14-2007, 08:59 AM
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
04-14-2007, 09:24 AM
This has also been posted here;

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

YellowLabPro
04-14-2007, 09:41 AM
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
04-14-2007, 06:10 PM
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
04-14-2007, 06:35 PM
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
04-14-2007, 06:46 PM
Rb-

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))

mdmackillop
04-15-2007, 12:49 AM
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.

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

YellowLabPro
04-15-2007, 05:19 AM
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