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

F

frewert

Board Regular
Joined
Apr 4, 2014
Messages
188
Office Version
  1. 365
Platform
  1. Windows
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 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)
VBA Code: 
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!
 

Excel Facts

What does custom number format of ;;; mean?
Three semi-colons will hide the value in the cell. Although most people use white font instead.
Sort by date Sort by votes
What should happen if there are multiple match? Example:
Size project method A.xlsm
A
81JM Collection Linen Shirt Womens 24W 3X Button Front Pocket Floral Tab Sleeve
82Maeve Womens Sz 4 Scallop Swiss Dot Blouse Top Blue Navy Rayon Crew Neck
83Terra & Sky Sheer Blouse Button Front Black Floral Long Sleeve Womens 3X 24W 26W
Sheet2

On row 81, "24W" & "3X" both match the criteria.
Same problem on row 83.
 
Upvote 0
Akuini said:
What should happen if there are multiple match? Example:
Size project method A.xlsm
A
81JM Collection Linen Shirt Womens 24W 3X Button Front Pocket Floral Tab Sleeve
82Maeve Womens Sz 4 Scallop Swiss Dot Blouse Top Blue Navy Rayon Crew Neck
83Terra & Sky Sheer Blouse Button Front Black Floral Long Sleeve Womens 3X 24W 26W
Sheet2

On row 81, "24W" & "3X" both match the criteria.
Same problem on row 83.
Click to expand...
There is a tier system for that. Tier 1 is beige, tier 2 is purple, tier 3 brown, tier 4 white. Each tier was sorted largest to small too. In a case where there are multiple matches, then the biggest is reported.
 
Upvote 0
Please try this code, if it works I'll add some comments to describe what the code does:
VBA Code: 
Sub frewert_1()
Dim regEx As Object, Matches As Object
Dim i As Long, j As Long, n As Long
Dim tx As String, pt As String
Dim va, vb, vc
With Range("F2", Cells(Rows.Count, "F").End(xlUp)).Resize(, 2)
    .Value = Application.Trim(.Value)
    vb = .Value
End With

va = Range("A2", Cells(Rows.Count, "A").End(xlUp))
ReDim vc(1 To UBound(va, 1), 1 To 1)
For i = 1 To UBound(va, 1)
    tx = va(i, 1)
    For Each x In Split(", / ( )", " ")
        tx = Replace(tx, x, " ")
    Next
    tx = " " & tx & " "
    va(i, 1) = Replace(tx, """", "ZZZ")
Next

    Set regEx = CreateObject("VBScript.RegExp")
    With regEx

            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
                        vc(i, 1) = vb(j, 2)
                        flag = True
                        Exit For
                    End If
                Next
                
                If flag = False Then
                    For Each pt In Split(" [0-9]{2}X[0-9]{2} | [0-9]{1,2}[MRLST] ", "|")
                        .Pattern = pt
                        If .test(tx) Then
                            Set Matches = .Execute(tx)
    '                         Debug.Print i & " : " & Matches(0) & " : " & Val(Matches(0))
                            vc(i, 1) = Val(Matches(0))
                            Exit For
                        End If
                    Next
                End If
            Next
End With
'put the result in col B:
Range("B2").Resize(UBound(vc, 1), 1) = vc
End Sub
 
Upvote 0
I get,
Compile error:
For Each control variable must be Variant or Object
 
Upvote 0
frewert said:
I get,
Compile error:
For Each control variable must be Variant or Object
Click to expand...
Sorry, wrong declaration, use this one:
VBA Code: 
Sub frewert_2()
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
With Range("F2", Cells(Rows.Count, "F").End(xlUp)).Resize(, 2)
    .Value = Application.Trim(.Value)
    vb = .Value
End With

va = Range("A2", Cells(Rows.Count, "A").End(xlUp))
ReDim vc(1 To UBound(va, 1), 1 To 1)
For i = 1 To UBound(va, 1)
    tx = va(i, 1)
    For Each x In Split(", / ( )", " ")
        tx = Replace(tx, x, " ")
    Next
    tx = " " & tx & " "
    va(i, 1) = Replace(tx, """", "ZZZ")
Next

    Set regEx = CreateObject("VBScript.RegExp")
    With regEx

            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
                        vc(i, 1) = vb(j, 2)
                        flag = True
                        Exit For
                    End If
                Next
                
                If flag = False Then
                    For Each pt In Split(" [0-9]{2}X[0-9]{2} | [0-9]{1,2}[MRLST] ", "|")
                        .Pattern = pt
                        If .test(tx) Then
                            Set Matches = .Execute(tx)
    '                         Debug.Print i & " : " & Matches(0) & " : " & Val(Matches(0))
                            vc(i, 1) = Val(Matches(0))
                            Exit For
                        End If
                    Next
                End If
            Next
End With
'put the result in col B:
Range("B2").Resize(UBound(vc, 1), 1) = vc
End Sub
 
Upvote 1
Solution
This worked perfectly. I can't believe it!
This project should help me price my items more accurately and improve my business by a lot.
Thank you.
 
Upvote 0
Ok, here I added some comments:
VBA Code: 
Sub frewert_2()
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
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)
For i = 1 To UBound(va, 1)
    tx = va(i, 1)
    For Each x In Split(", / ( )", " ") 'replace some characters with a space
        tx = Replace(tx, x, " ")
    Next
    tx = " " & tx & " "   'add space at the beginning and end of each record
    va(i, 1) = Replace(tx, """", "ZZZ")  'replace " with ZZZ so record with " will be ignored
Next

    Set regEx = CreateObject("VBScript.RegExp")
    With regEx

            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 F
                        vc(i, 1) = vb(j, 2)                  'if True then add col G value to variable vc
                        flag = True
                        Exit For
                    End If
                Next
                
                If flag = False Then 'if the above checking 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
                            Exit For
                        End If
                    Next
                End If
            Next
End With
'put the result in col B:
Range("B2").Resize(UBound(vc, 1), 1) = vc
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

L
  • Solved
VBA Find Cell from Date listed, in Columns, Return cell to highlight in color
Replies
7
Views
532
mumps
mumps
O
  • Solved
transfer data from userform by matching items in combobox with headers in sheet
Replies
4
Views
224
Omar M
O
O
  • Solved
Insert two columns by select item from combobox on userform
Replies
4
Views
163
Omar M
O
PuntingJawa
  • Solved
If column B has # then pull data from column A beside it
Replies
4
Views
227
PuntingJawa
PuntingJawa
C
  • Question Question
Stock inventory - count unique sequences from barcode
Replies
0
Views
574
ChemistryBMS
C

Forum statistics

Threads
1,224,820
Messages
6,181,155
Members
453,021
Latest member
Justyna P

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