Find size data from Item Title column to create a Size column

[frewert]

Originally the workbook only contained Column A and the intention is to create Column C (Size Column).

Here is my workbook so far.

Size project method A.xlsm

drive.google.com

Here is an image preview.

https://imgur.com/a/nOEYEbC

I have highlighted the ones that aren't working as intended and put a column of what the desired result should be.

You will notice I have columns F and G that are valid sizes and conversions.

My goals now:

• Item Titles with (Number)X(Number) should return the first number. E.g., 32X30 should return 32.
• Item Titles with M/L are returning nothing. It should return L (the largest size)
• Item Titles ending in 0,2,4,6,8,S,M,L are not returning a result. Something to do with not being surrounding by the space character.
• Item Titles with 6S, 6R, 6M, 6L, 6T should return 6. (Should work with all numbers, not just 6 in example)

Here is the vba code used. (credit: reddit.com/user/arkangelshadow007)

Sub shoe_sizes()

Dim items As Range, validSizes As Range, conversion As Range

Set validSizes = Range("f2:f200") 'adjust ranges
Set conversion = Range("g2:g200")
Set items = Range("a2:a4200")

For Each Item In items.Cells

    For Each validSize In validSizes.Cells

        x = InStr(Item.Value, validSize.Value)

        If x > 0 Then

            Cells(Item.Row, 3) = Cells(validSize.Row, 7)

            GoTo next_item

        End If

    Next validSize

next_item:

Next Item

End Sub

Thank you!

 

[Akuini]

Glad it works.
One thing:
Is "Inseam" always preceded by number? like your example: "32 Inseam"
If not, say there could be something like "Bag Inseam", then please change this part:

    va(i, 1) = Replace(tx, " Inseam", "Inseam") '   Maybe ignore "(number) Inseam"

to this:

   If tx Like "*# Inseam*" Then tx = Replace(tx, " Inseam", "Inseam")
    va(i, 1) = tx

 

[frewert]

99% of it is (Number) Inseam. I see two varieties:

• (Number)" Inseam
• (Number) Inseam

(Number) could be in the following formats:

• #
• ##
• #.#
• ##.#

 

[Akuini]

The number in this:
(Number)" Inseam
will be ignored because it's followed by "
tx = Replace(tx, """", "ZZZ") 'replace " with ZZZ so word/number with " will be ignored

so you don't need to change the code.
Another thing:
Is it possible that any word in Category (col H) is followed by a ", such as Bag"?

 

[frewert]

No that's not possible. Every instance of " follows a number.

 

[Akuini]

No that's not possible. Every instance of " follows a number.

Ok, it's good then.

 

[frewert]

Thanks for your help thus far. I figured those 2 columns might be impossible to get right.

We only need Gender and Condition columns now. Hopefully a lot easier than the first ones!

 

[Akuini]

We only need Gender and Condition columns now. Hopefully a lot easier than the first ones!

So, where are the list of Gender and Condition?

 

[frewert]

Ok so they go as the following:

Gender column:

• Womens
• Mens
• Boys
• Girls
• Unisex
• Blank (if none of those are found)

Condition:

• New
• Pre-owned

If "NWT" is in the title, it is New. If it does not have "NWT", it is Pre-owned.

 

[Akuini]

Ok so they go as the following:

Try this:
I put the list of Gender & Condition in the code instead of the sheet, so you don't need Gender & Condition list column.

Sub frewert_6()
Dim regEx As Object, Matches As Object
Dim i As Long, j As Long, n As Long
Dim tx As String, pt
Dim va, vb, vc, ary
Dim Flag As Boolean

t = Timer

Range("B2:E500000").ClearContents  'clear col B:E

With Range("F2", Cells(Rows.Count, "F").End(xlUp)).Resize(, 2)
    .Value = Application.Trim(.Value)  'trim trailing space in data in col A
    vb = .Value
End With

va = Range("A2", Cells(Rows.Count, "A").End(xlUp)) 'populate va with col A data
ReDim vc(1 To UBound(va, 1), 1 To 1)

Debug.Print "Number of records  :" & " : " & UBound(va, 1)
Debug.Print "Number of Size List  :" & " : " & UBound(vb, 1)

For i = 1 To UBound(va, 1)
    tx = va(i, 1)
    
    For Each x In Split(", / \ ( ) . ; : [ ]", " ") 'replace some characters with a space (exclude ")
        tx = Replace(tx, x, " ")
    Next
    tx = " " & tx & " "   'add space at the beginning and end of each record
    tx = Replace(tx, """", "ZZZ")  'replace " with ZZZ so word/number with " will be ignored
    
    tx = Replace(tx, "Short Sleeve", " Sleeve")             'replace "Short Sleeve" with " Sleeve"
    tx = Replace(tx, "Polo Ralph Lauren", " Ralph Lauren")
    tx = Replace(tx, "Polo Jeans Co", " Jeans Co")
    tx = Replace(tx, "US Polo Assn", "US Assn")
    tx = Replace(tx, "US Polo Assn", "US Assn")
'    va(i, 1) = Replace(tx, " Inseam", "Inseam") '   Maybe ignore "(number) Inseam"
    If tx Like "*# Inseam*" Then tx = Replace(tx, " Inseam", "Inseam")
    va(i, 1) = tx
Next

    Set regEx = CreateObject("VBScript.RegExp")
    With regEx
    ary = Split("Ties|Scarves|Wallets|Hats|Bags", "|")
            
'            ============= Size =============================================
            For i = 1 To UBound(va, 1)
                Flag = False
                tx = va(i, 1)
                
                For Each x In ary  'deal with "Ties|Scarves|Wallets|Hats|Bags"
                     If InStr(tx, " " & x & " ") Then Flag = True: Exit For
                Next
                
                If Flag = False Then   '
                    If InStr(tx, " " & "Torrid" & " ") Then           'deal with Torrid
                        For Each x In Split("0 1 2 3 4 5 6", " ")
                            If InStr(tx, " " & x & " ") Then
                                vc(i, 1) = x & "X"
                                Flag = True: Exit For
                            End If
                        Next
                    End If
                End If
                
                If Flag = False Then
                    For j = 1 To UBound(vb, 1)
                        If InStr(tx, " " & vb(j, 1) & " ") Then  'check if a record has items in list in col F
                            vc(i, 1) = vb(j, 2)                  'if True then add col G value to variable vc
                            Flag = True: Exit For
                        End If
                    Next
                End If
                
                If Flag = False Then 'if the above cheking give empty result
                    For Each pt In Split(" [0-9]{2}X[0-9]{2} | [0-9]{1,2}[MRLST] ", "|")  'use this regex pattern to check
                        .Pattern = pt
                        If .test(tx) Then
                            Set Matches = .Execute(tx)
'                             Debug.Print i & " : " & Matches(0) & " : " & Val(Matches(0))
                            vc(i, 1) = Val(Matches(0))    'if there's a match then add the match to variable vc
                            Flag = True: Exit For
                        End If
                    Next
                End If
           

            Next
            
'put the result (of Size) in col C:
Range("B2").Resize(UBound(vc, 1), 1) = vc
                        
'===================== Category ======================

    With Range("H2", Cells(Rows.Count, "H").End(xlUp)).Resize(, 3)
        .Value = Application.Trim(.Value)                          'trim trailing space in data in col H:I
        vb = .Value                                                'load data to vb from col H:I
    End With
    
    For i = 1 To UBound(vb, 1)
        vb(i, 3) = Len(vb(i, 1))  'load col H word length to 3rd col in vb
    Next
    
    vb = WorksheetFunction.Sort(vb, 3, -1)  'sort vb by word length

    ReDim vc(1 To UBound(va, 1), 1 To 1)
        For i = 1 To UBound(va, 1)
            Flag = False
            tx = va(i, 1)
            For j = 1 To UBound(vb, 1)
                If InStr(tx, " " & vb(j, 1) & " ") Then  'check if a record has items in list in col H
                        vc(i, 1) = vb(j, 2)                  'if True then add col I value to variable vc
                        Flag = True: Exit For
                End If
            Next
        Next
            
End With

'put the result (of Category) in col C:
Range("C2").Resize(UBound(vc, 1), 1) = vc

'==================== GENDER ============================================================

'Womens|Mens|Boys|Girls|Unisex|Blank
    ReDim vc(1 To UBound(va, 1), 1 To 1)
        
       ary = Split("Womens|Mens|Boys|Girls|Unisex", "|")
            
            For i = 1 To UBound(va, 1)
                Flag = False
                For Each x In ary
                     If InStr(va(i, 1), " " & x & " ") Then
                        vc(i, 1) = x
                        Flag = True: Exit For
                     End If
                Next
                If Flag = False Then vc(i, 1) = "Blank"
            Next

'put the result (of GENDER) in col D:
Range("D2").Resize(UBound(vc, 1), 1) = vc


'========================= Condition =============================

'If "NWT" is in the title, it is New. If it does not have "NWT", it is Pre-owned.
    ReDim vc(1 To UBound(va, 1), 1 To 1)

            For i = 1 To UBound(va, 1)
                     If InStr(va(i, 1), " " & "NWT" & " ") Then
                        vc(i, 1) = "New"
                     Else
                        vc(i, 1) = "Pre-owned"
                     End If
            Next
'put the result (of Condition) in col E:
Range("E2").Resize(UBound(vc, 1), 1) = vc


Debug.Print "Number of Category List  :" & " : " & UBound(vb, 1)
Debug.Print "Completion time:  " & Format(Timer - t, "0.00") & " seconds"

End Sub

 

[frewert]

Looks good. Runs flawlessly.

With this, I can resume my business and start listing new items again. Thanks for all your help!