Solved: Loop Help

[YellowLabPro]

In column I, beginning in I6 to the last row I want to cut the first term and paste it to column H.
There will be a space between the first and second term that will need to be removed. Either remove the space between the first and second term after cut/paste or remove it during the paste function into col. H.

I would also like to do something similar as to locate the color of the item in column I and cut/paste into column M.
I can build a table w/ valid colors, but just need to know where and how to store the table.

Thanks,

YLP

[mvidas]

Hi,

So for your column I you basically want to do a Data / Text to Columns, but anything before the first space goes to the cell to the left?Sub YelpSplit()
Dim RG As Range, TempArr() As Variant, i As Long, iPos As Long

'set range to split
Set RG = Range("I6", Cells(Rows.Count, "I").End(xlUp))

'transfer range data into array
TempArr = RG.Value

'resize array to add an extra 'column'
ReDim Preserve TempArr(1 To RG.Rows.Count, 1 To 2)

'loop through each cell's contents, splitting as needed
For i = 1 To RG.Rows.Count

'find position of first space
iPos = InStr(1, TempArr(i, 1), " ")

'put anything after first space into second 'column' of array
TempArr(i, 2) = Mid(TempArr(i, 1), iPos + 1)

If iPos = 0 Then 'if there is not a space then clear first 'column'
TempArr(i, 1) = ""
Else 'otherwise put text to left of first space in column1
TempArr(i, 1) = Left(TempArr(i, 1), iPos - 1)
End If
Next 'next 'row'

'transfer data back to resized range
RG.Offset(0, -1).Resize(RG.Rows.Count, 2).Value = TempArr
End Sub
Not sure what you mean about the colors, do the cells have colors listed in them, or do you mean font or background color?

Matt

[YellowLabPro]

Matt,
That is Fantastic! Thank you!
A number of the cells in the same range will have colors as a part of the descriptions, I am hopeful that we can find these terms and place them in Column M.
Here is an example- that is in I54:
CRIMSON MARKOVICH BLUE FACES
After running your code for splitting out H54 is:
CRIMSON
I54 is:
MARKOVICH BLUE FACES

I would like I54 to be:
MARKOVICH FACES
and M54 to be:
BLUE

I already have a table of valid colors that we could run a check against.

Thanks again...

Doug

[mvidas]

Hi Doug,

Sure, give this a try:Sub YelpSplit()
Dim RG As Range, TempArr() As Variant, i As Long, iPos As Long
Dim vColor As Variant, vColors() As Variant, ColorData() As Variant

'set colors list (this could be pulled from spreadsheet if desired
vColors = Array("red", "orange", "yellow", "green", "blue", "indigo", "violet")

'set range to split
Set RG = Range("I6", Cells(Rows.Count, "I").End(xlUp))

'transfer range data into array
TempArr = RG.Value

'resize array to add an extra 'column', create colordata array
ReDim Preserve TempArr(1 To RG.Rows.Count, 1 To 2)
ReDim Preserve ColorData(1 To RG.Rows.Count, 1 To 1)

'loop through each cell's contents, splitting as needed
For i = 1 To RG.Rows.Count

'find position of first space
iPos = InStr(1, TempArr(i, 1), " ")

'put anything after first space into second 'column' of array
TempArr(i, 2) = Mid(TempArr(i, 1), iPos + 1)

If iPos = 0 Then 'if there is not a space then clear first 'column'
TempArr(i, 1) = ""
Else 'otherwise put text to left of first space in column1
TempArr(i, 1) = Left(TempArr(i, 1), iPos - 1)
End If

'check to see if color exists in second 'column'
ColorData(i, 1) = ""
For Each vColor In vColors
'see if color is in text
iPos = InStr(1, TempArr(i, 2), vColor, vbTextCompare)
If iPos > 0 Then 'if so..
'put color text into colordata array
ColorData(i, 1) = Mid(TempArr(i, 2), iPos, Len(CStr(vColor)))
'remove color text from original
TempArr(i, 2) = Left(TempArr(i, 2), iPos - 1) & _
Mid(TempArr(i, 2), iPos + Len(CStr(vColor))) ' + 1)
Exit For
End If
Next 'next color

Next 'next 'row'

'transfer data back to resized range
RG.Offset(0, -1).Resize(RG.Rows.Count, 2).Value = TempArr
'transfer color data into column M (4 columns to right of column I)
RG.Offset(0, 4).Value = ColorData
End SubMatt

[YellowLabPro]

Matt,
I hate to mention this now after you gave me such great code. Because the way you wrote the code initially, I thought we would handle them completely separate. I should have mentioned this previously.
We need the color code to work separately from the first term. The reason being is that some of the first term values, which are company name are colors, ie. Chocolate, Yellow are company names and valid colors. By moving the names out to the H first, this prevents the confusion between company names and colors.
I was splitting out the code but realized after going through it, I think you may have some interlinked code and I do not feel qualified to edit your code.
sorry....

Doug

[mvidas]

I think I may be missing your point.. if you have a cell that contains "BLUE SHARPIE MARKER", it will put BLUE in column G, SHARPIE MARKER in H, and nothing in M.. it does extract the first word before looking at the colors.. did you want it to do something different?

[YellowLabPro]

Maybe I am mistaken,
Lets try this,
YELLOW SHARPIE BLUE MARKER is in I,
YELLOW Would go in G, SHARPIE MARKER would stay in I, and BLUE would go in M.

[mvidas]

That is what my code does. What do you want it to do?

[mvidas]

And by the way, feel free to play around with my code. I tried to comment it as much as I could so that you could edit it to suit your needs. Of course feel free to ask any questions you'd like, but that you're asking for code means to me that you're qualified enough to modify it :) if your changes dont end up working, you can always just replace the changed code with the original

[mvidas]

And as the code is written, "SHARPIE MARKER" would be in G (if the forum trims this, I have 2 spaces between the two words). I originally added something to remove that space (the commented out part of this): Mid(TempArr(i, 2), iPos + Len(CStr(vColor))) ' + 1) but once I tested it on a cell that said "burger with cheese (american yellow)" and it split it into "burger" "with cheese (american " and "yellow" and the last parenthesis is dropped. if this will not occur for you, change the above line to:Mid(TempArr(i, 2), iPos + Len(CStr(vColor)) + 1)

[YellowLabPro]

Thanks Matt,
Got it. I did not test the code intially, silly on my part.... I was reading it thinking I needed to add to what you gave me and you had already taken care of it I see now. I don't think I will ever have any parantesis in my terms, so I removed the comment and last closing paranthesis.

You make the reference that Sharpie Marker is in G, but my terms are in col. I and this works as it should.... hopefully I am not misunderstanding, all is good :-). As it sits right now, this works perfectly to the naked eye.

**If we could add the table of colors, as you mentioned earlier, that would be a tremendous help.**

I also need help in another loop for this sheet that afterwords I am going to post in a separate issue to keep things clean and not overwhelm you.

Much appreciated,

Doug

[mvidas]

I'm happy to help, and not in much of a mood to do my actual work this afternoon :)' vColors = Array("red", "orange", "yellow", "green", "blue", "indigo", "violet")
vColors = Sheets("Sheet2").Range("A1:A7").ValueI wrote the code to iterate through the vColors array so this line could go either way (either from an Array() call or an array transfer from a range)


Since it's a separate issue you might as well post it separately, but I'll take a look at it and see if I can help (providing no one else is helping when I do)

EDIT: I just re-read my comment and you were right about the column G/I thing. The backwards extraction keeps throwing me off :)

[YellowLabPro]

We are getting there..... hoooorahhhh

The color table is one thing that is not working for me just yet....
Your way is fine.
I tried to use a LastRow, but this failed. Not sure why.... 1st line does not work, second one does

'vColors = Sheets("Table").Range("A2:A" & LRow).Value
vColors = Sheets("Table").Range("A1:A385").Value

[mvidas]

By appearances it should work.. I do have a couple "d'oh" questions that will likely fix it for you:
Did you leave that line commented out (causing it not to run)?
Did you put LRow instead of LastRow (as your comment suggests)?
Is LRow being set with anything?

Are you just looking to go from A1 til the last used row in A? With Sheets("Table")
vColors = .Range("A1", .Cells(.Rows.Count, 1).End(xlUp)).Value
End With

[YellowLabPro]

I only have it commented out so I could test w/ a fixed range.
Yes LRow is used, I spelled it out to avoid confusion, but created more...
LRow is set to: LRow = wss.Cells(Rows.Count, 1).End(xlUp).Row

Relevant Block:
Sub YelpSplit()
Dim RG As Range, TempArr() As Variant, i As Long, iPos As Long
Dim vColor As Variant, vColors() As Variant, ColorData() As Variant
Dim LRow As Long
Dim wsb As Workbook, wst As Worksheet, wss As Worksheet

Set wsb = Workbooks("TGSItemRecordCreatorMaster.xls")
Set wst = Workbooks("TGSItemRecordCreatorMaster.xls").Worksheets("Record Creator")
Set wss = Workbooks("TGSItemRecordCreatorMaster.xls").Worksheets("Table")

LRow = wss.Cells(Rows.Count, 1).End(xlUp).Row

'set colors list (this could be pulled from spreadsheet if desired
'vColors = Array("red", "orange", "yellow", "green", "blue", "indigo", "violet")
'vColors = Sheets("Table").Range("A1:A385").Value
vColors = Sheets("Table").Range("A2:A" & LRow).Value

[YellowLabPro]

Matt,
That all works now. But we do have one problem, if a color like "Tan" is in a word like "Stand", then we have a slight problem.

[YellowLabPro]

This is something that Mdmackillop came up for me in another unrelated file;
With Ws
For Each c In Intersect(Ws.Columns(3), Ws.UsedRange)
If InStr(c, " JKT ") > 0 Then c.Formula = _
Application.WorksheetFunction.Substitute(c.Formula, " JKT ", " JACKET ")

Maybe we can incorporate something w/ this.

[mvidas]

Well, getting it working (even if not fully working) is always good :)

I can easily write something to only check for actual color words (re: tan/stand) using one of my favorite tools, regular expressions. Doing that pushes this project over the line from relatively-easy to quite-a-bit-more-complicated (at least for you to edit in the future).
As far as speed and performance go, using it will be pretty fast and quite powerful. But as I said, maintaining it (at least from your perspective) may be a bit tougher. Still interested? At the very least it could provoke you to want to learn about regexps :)

Either way I'll write it up (though looking at the time I may not get to it until tomorrow--depending on my evening), so you can at least try it out.

[mvidas]

Looking for a space beforehand or a space after (or both) can work, but using the "tan" example, what if you had "afghanistan" or "tangible" (ending and starting with 'tan'). Looking for a space before and after could work, but if it is the last word in the cell then there wouldn't be a space after it (or even a period/punctuation could throw it off). Using regexp works well since you can specify word boundaries

[YellowLabPro]

Thanks Matt,
I am game if you don't mind helping me if I have to limp through it for awhile until I get it down. I am always up for learning more.... and if it is not until tomorrow that is quite alright.

I am going to post the other loop question, if you have the time.... I am still just getting the loop thing

[mvidas]

Alright, just had a little free time. Give this a try, tried to comment as much as i couldSub YelpSplitV2()
Dim SplitRG As Range, TempArr() As Variant, i As Long, ColorString As String
Dim vColors() As Variant, ColorData() As Variant, ColorRG As Range
Dim RegEx2 As Object, RegEx As Object, RegM As Object, RegM2 As Object

'set ranges
With Workbooks("TGSItemRecordCreatorMaster.xls") 'workbook, could use ActiveWorkbook
With .Worksheets("Record Creator") 'Set input range
Set SplitRG = .Range("I6", .Cells(.Rows.Count, "I").End(xlUp))
End With
With .Worksheets("Table") 'Set color table
Set ColorRG = .Range("A2", .Cells(.Rows.Count, 1).End(xlUp))
End With
End With

'set colors list
vColors = ColorRG.Value
ColorString = "\b" & vColors(1, 1) & "\b"
For i = 1 To UBound(vColors, 1)
ColorString = ColorString & "|" & "\b" & vColors(i, 1) & "\b"
Next

'create/initialize regular expression objects
Set RegEx = CreateObject("vbscript.regexp") 'use RegEx for splitting into 2
RegEx.Pattern = "^(\S+) (.+)$"
Set RegEx2 = CreateObject("vbscript.regexp") 'use RegEx2 for splitting color
With RegEx2
.IgnoreCase = True
.Pattern = "(.*?)(" & ColorString & ")(.*)"
End With

'transfer range data into array
TempArr = SplitRG.Value

'resize array to add an extra 'column', create colordata array
ReDim Preserve TempArr(1 To SplitRG.Rows.Count, 1 To 2)
ReDim Preserve ColorData(1 To SplitRG.Rows.Count, 1 To 1)

'loop through cell array, pattern testing and splitting
For i = 1 To SplitRG.Rows.Count 'loop through each "cell"
If RegEx.Test(TempArr(i, 1)) Then 'check to see if there is a space
Set RegM = RegEx.Execute(TempArr(i, 1)).Item(0) 'create match object to parse
TempArr(i, 1) = RegM.SubMatches(0) 'put first word in column 1
If RegEx2.Test(RegM.SubMatches(1)) Then 'check to see if color in rest
Set RegM2 = RegEx2.Execute(RegM.SubMatches(1)).Item(0) 'create match object
ColorData(i, 1) = RegM2.SubMatches(1) 'put color submatch into color array
TempArr(i, 2) = RegM2.SubMatches(0) & Trim(RegM2.SubMatches(2)) 'fill col2
Else 'if no color in text
TempArr(i, 2) = RegM.SubMatches(1) 'put rest of text in column 2
End If
Else 'if cell is only one word
TempArr(i, 2) = TempArr(i, 1) 'put word in column 2
TempArr(i, 1) = "" 'empty column 1
End If
Next 'i

'transfer data back to resized range
SplitRG.Offset(0, -1).Resize(SplitRG.Rows.Count, 2).Value = TempArr

'transfer color data into column M (4 columns to right of column I)
SplitRG.Offset(0, 4).Value = ColorData
End SubWorked well in my testing, give it a shot

[YellowLabPro]

Matt,
Looks Great! It worked beautifully w/out anything other from me than hitting the play button.
I do have two questions, 1) what could happen if we had two colors in the cell and they are valid colors, eg. Blue/Blue, could this be identified?
2) You mentioned earlier today that managing this would be harder / more involved. What sort of things are you thinking I will need to be aware of and on the lookout for?

[mvidas]

1) Sure. Would you always want color1/color2 or color1/color2/color3 or do you want it listed differently?

2) It would really only be tougher since im guessing it is new to you. It really is pretty easy once you understand how it works (see a KB entry by brettdj for a great tutorial on regular expressions).

[YellowLabPro]

Matt,
Sorry, don't really follow what you mean by "color1/color2 or color1/color2/color3 or do you want it listed differently?"

[mvidas]

If your cell contains "CRIMSON MARKOVICH BLUE FACES TAN TOPS", how do you want column M formatted? do you want column M to say "BLUE/TAN"?

[YellowLabPro]

Aahhhhh-
No actually the second color goes in col. R and we use a slash "/" between the two colors.
So Blue Tan or Blue/Tan in col. I would be Blue in col. M and /Tan in col R.
"Hope I am not killing you right now, and better yet, you are not ready to kill me" : pray2: :)

[mvidas]

Oh, I see it literally has "Blue/Tan" in the description :) Mis-read on my part.
I should ask -- Could there ever be 3 colors like that? and are you sure you would want /Tan in R and not just Tan?

[mvidas]

Ok, assuming that is correct, make the following changes (shorter than just posting entirely new code). Look for "'*****" to see additions/changes:'add to Dim statements
Dim ColorData2() As Variant '***** ADDED

'change pattern for RegEx2
With RegEx2
.IgnoreCase = True
'.Pattern = "(.*?)(" & ColorString & ")(.*)"
.Pattern = "(.*?)(" & ColorString & ")(/?(" & ColorString & ")?)(.*)" '***** CHANGED
End With

'add redim for colordata2 array
'resize array to add an extra 'column', create colordata arrays
ReDim Preserve TempArr(1 To SplitRG.Rows.Count, 1 To 2)
ReDim Preserve ColorData(1 To SplitRG.Rows.Count, 1 To 1)
ReDim Preserve ColorData2(1 To SplitRG.Rows.Count, 1 To 1) '***** ADDED

'Populate colordata2 array with second color (if any),
' also change what is put into temparr(i,2) (the non-color part of cell)
If RegEx2.Test(RegM.SubMatches(1)) Then 'check to see if color in rest
Set RegM2 = RegEx2.Execute(RegM.SubMatches(1)).Item(0) 'create match object
ColorData(i, 1) = RegM2.SubMatches(1) 'put color submatch into color array
ColorData2(i, 1) = RegM2.SubMatches(2) 'put second color into color2 array '***** ADDED
TempArr(i, 2) = RegM2.SubMatches(0) & Trim(RegM2.SubMatches(4)) 'fill col2 '***** CHANGED
Else 'if no color in text

'add colordata2 array to worksheet at end of sub
SplitRG.Offset(0, 4).Value = ColorData
SplitRG.Offset(0, 9).Value = ColorData2 '***** ADDED :)

[YellowLabPro]

Hey Matt, Good morning.....
I have been doing some reading on looping. I went back to a post you provided w/ the three examples, it is starting to click. It helped to go through the code line by line and watch what individual changes it made...

Ok... so I think there may be times when three colors will pop up, but is not a regular occurrence. I will go back and look at some previous files today and see.

The colors, regarding Blue Tan and Blue/Tan could show up either way. Typically there will be a slash. To answer the question do I want to place a slash in front of the second color in col. R, yes. The reason being is that I build the item record# and the product description dynamically from the values in each cell, the "/" is substitued out w/ nothing in the Product ID, but is used to combine the colors in the product description.
Does this help?

thanks for all the time here.... really appreciate it,

Doug

[mvidas]

New version (see after code for details):Sub YelpSplitV2()
Dim SplitRG As Range, TempArr() As Variant, i As Long, ColorString As String
Dim vColors() As Variant, ColorData() As Variant, ColorRG As Range
Dim RegEx2 As Object, RegEx As Object, RegM As Object, RegM2 As Object
Dim ColorData2() As Variant

'set ranges
With Workbooks("TGSItemRecordCreatorMaster.xls") 'workbook, could use ActiveWorkbook
With .Worksheets("Record Creator") 'Set input range
Set SplitRG = .Range("I6", .Cells(.Rows.Count, "I").End(xlUp))
End With
With .Worksheets("Table") 'Set color table
Set ColorRG = .Range("A2", .Cells(.Rows.Count, 1).End(xlUp))
End With
End With

'set colors list
vColors = ColorRG.Value
ColorString = "\b" & vColors(1, 1) & "\b"
For i = 1 To UBound(vColors, 1)
ColorString = ColorString & "|" & "\b" & vColors(i, 1) & "\b"
Next

'create/initialize regular expression objects
Set RegEx = CreateObject("vbscript.regexp") 'use RegEx for splitting into 2
RegEx.Pattern = "^(\S+) (.+)$"
Set RegEx2 = CreateObject("vbscript.regexp") 'use RegEx2 for splitting color
With RegEx2
.IgnoreCase = True
.Pattern = "(.*?)(" & ColorString & ")(([/ ]?(" & ColorString & ")?)*)(.+)"
End With

'transfer range data into array
TempArr = SplitRG.Value

'resize array to add an extra 'column', create colordata arrays
ReDim Preserve TempArr(1 To SplitRG.Rows.Count, 1 To 2)
ReDim Preserve ColorData(1 To SplitRG.Rows.Count, 1 To 1)
ReDim Preserve ColorData2(1 To SplitRG.Rows.Count, 1 To 1)

'loop through cell array, pattern testing and splitting
For i = 1 To SplitRG.Rows.Count 'loop through each "cell"
If RegEx.Test(TempArr(i, 1)) Then 'check to see if there is a space
Set RegM = RegEx.Execute(TempArr(i, 1)).Item(0) 'create match object to parse
TempArr(i, 1) = RegM.SubMatches(0) 'put first word in column 1
If RegEx2.Test(RegM.SubMatches(1)) Then 'check to see if color in rest
Set RegM2 = RegEx2.Execute(RegM.SubMatches(1)).Item(0) 'create match object
ColorData(i, 1) = RegM2.SubMatches(1) 'put color submatch into color array
' ColorData2(i, 1) = RegM2.SubMatches(2) 'put second color into color2 array
If Len(Trim(RegM2.SubMatches(2))) > 0 Then 'put second color into color2 array
ColorData2(i, 1) = Trim("/" & Mid(RegM2.SubMatches(2), 2))
ColorData2(i, 1) = Replace(ColorData2(i, 1), " ", "/")
End If
TempArr(i, 2) = RegM2.SubMatches(0) & Trim(RegM2.SubMatches(5)) 'fill col2
Else 'if no color in text
TempArr(i, 2) = RegM.SubMatches(1) 'put rest of text in column 2
End If
Else 'if cell is only one word
TempArr(i, 2) = TempArr(i, 1) 'put word in column 2
TempArr(i, 1) = "" 'empty column 1
End If
Next 'i

'transfer data back to resized range
SplitRG.Offset(0, -1).Resize(SplitRG.Rows.Count, 2).Value = TempArr

'transfer color data into column M and R
' (4 and 9 columns to right of column I)
SplitRG.Offset(0, 4).Value = ColorData
SplitRG.Offset(0, 9).Value = ColorData2
End Sub
Really only 3 or 4 lines got changed, but I figured I'd post the whole thing to make it a little easier for you. There is no limit to the colors you can have in there now (as long as they're in a row). Some examples:

Input: "CRIMSON MARKOVICH BLUE FACES"
ColH: "CRIMSON"
ColI: "MARKOVICH FACES"
ColM: "BLUE"
ColR: ""

Input: "random words tan/blue stuff"
ColH: "random"
ColI: "words stuff"
ColM: "tan"
ColR: "/blue"

Input: "red orange yellow green blue indigo violet"
ColH: "red"
ColI: "violet"
ColM: "orange"
ColR: "/yellow/green/blue/indigo"
(note that "violet" is in column I, I did that so there would always be something in I. If you dont want that, it is a very simple change

Input: "one"
ColH: ""
ColI: "one"
ColM: ""
ColR: ""

Input: "silly marko tan/blue/red stuff"
ColH: "silly"
ColI: "marko stuff"
ColM: "tan"
ColR: "/blue/red"

Input: "one two bluegreen three"
ColH: "one"
ColI: "two bluegreen three"
ColM: ""
ColR: ""

[YellowLabPro]

Matt,
The colors are not working perfect quite just yet. If there are two colors and a slash, it places the first color in M and the slash in R and leaves the second color in I.
3 colors: Similar: color 1 in M, color 2 in I and color 3 in R w/ a slash before and after the color.

[mvidas]

Please give me an actual example of what you mean, and what you want

[YellowLabPro]

Note*
I replaced all the code w/ your last version, I believe that is what you wanted me to do.

Sure thing:
I54 & I55 respectively, difference is slash between colors:
Crimson MARKOVICH FACES Red Blue Green
Crimson MARKOVICH FACES Red/Blue/Green

Results in:
H54:
Crimson
I54:MARKOVICH FACES Green
M54:
Red
R54:
/Blue
IDEALLY DESIRED:
H54 is fine: Crimson
I54: MARKOVICH FACES
M54 is fine: Red
R54: /Blue/Green
----------------------------------
Results in
H55:
Crimson
I55:
MARKOVICH FACES Green
M55:
Red
R55:
/Blue/
IDEALLY DESIRED:
H55 is fine: Crimson
I55: MARKOVICH FACES
M55 is fine: Red
R55: /Blue/Green

[mvidas]

(yes, replace all is correct :))

I gotcha.. that is easily fixed, by changing the + at the end of regex2's pattern to a *:'.Pattern = "(.*?)(" & ColorString & ")(([/ ]?(" & ColorString & ")?)*)(.+)"
.Pattern = "(.*?)(" & ColorString & ")(([/ ]?(" & ColorString & ")?)*)(.*)"
Though I'm sure this is unlikely, it still should be addressed. If the cell in column I contains "Crimson Red", do you want "Red" in column M or in column I ?

[YellowLabPro]

Thanks Matt,
Good, wanted to make sure I was not botching something....

I will make the change, test and repost.

Good Point- "Crimson Red"
If "Crimson Red" exists, Red would stay in I. But it is highly unlikely, we would not have a product called RED and will almost assuredly be a color. But I learned a long time ago, never say never.....

I will post back shortly...

[mvidas]

Ok.. after a bit of playing around and testing, if your product name contains ONLY colors, it will require manual intervention. No easy way around that. I wrote something to handle cases of "Crimson Red", but when there are multiple colors after the first word ("crimson red orange yellow") -- it left the colors in I and nothing in M or R.

So I decided that in the unlikely scenario that the product name is a color, it will just MsgBox you alerting you. I'm including the first line here of the 4 so you know where to put the If block: TempArr(i, 2) = RegM2.SubMatches(0) & Trim(RegM2.SubMatches(5)) 'fill col2
If Len(TempArr(i, 2)) = 0 Then
MsgBox "No Product Detected in '" & RegM & "'"
End If

[YellowLabPro]

Matt,
We got one of the two resolved, hooorahhhh.

The colors that do not have a slash between them works perfectly, the colors that do have a slash separating them do not pull any colors out, it leaves them intact in col. I

we are getting there, thanks for your patience

[mvidas]

It shouldn't.. if I have "silly marko tan/blue/red stuff" to start, it puts "silly" in colH, "marko stuff" in colI, "tan" in colM, and "/blue/red" in colR.. could it be that a \ was used instead of / ? If so, in the .Pattern line, change "[/ ]" to "[/ \\]"

[YellowLabPro]

Matt,
Everything is working fine now. Not sure what the problem was earlier, might have been memory related. My system starts acting funny when a lot of data or time passes through. I did not change anything and been testing it pretty hard and it works brilliantly.
I am going to go back now and put the last bit of code you gave me in and see how it works.

Thanks,

Doug

[YellowLabPro]

Matt,
This works awesome!!!!!!!!!! I tried the msgbox and that too is brilliant!

:bow: I can only say thank you and man o' man..... thanks for your patience and assistance.

Doug

[mvidas]

Glad to hear it :)

[YellowLabPro]

Matt,
I am using your code that finds the color, all works really well, but did have one odd instance.
This is the Original value in "I18":
I18 = SFW BLACK BIGHEAD 52mm black
It gets broken out to this in the appropriate cells in row 18
H18= SFW : I18= BIGHEAD 52mm black: M18= BLACK
Which is strange because the color black is still remaining in I18, but then in M18, BLACK appears and it is in uppercase. This was sort of the maiden run w/ the code on a new set of data.
All the other rows w/ color returned expected results....
Any thoughts?

Thanks,

Doug

[mvidas]

Matt,
I am using your code that finds the color, all works really well, but did have one odd instance.
This is the Original value in "I18":
I18 = SFW BLACK BIGHEAD 52mm black
It gets broken out to this in the appropriate cells in row 18
H18= SFW : I18= BIGHEAD 52mm black: M18= BLACK
Which is strange because the color black is still remaining in I18, but then in M18, BLACK appears and it is in uppercase. This was sort of the maiden run w/ the code on a new set of data.
All the other rows w/ color returned expected results....
Any thoughts?

Thanks,

DougWhat would you rather it do? it finds the first instance of a color ("BLACK"), and since there is no /BLUE or any other color immediately following it, it moves just that to M, and moves the remainder of the cell ("BIGHEAD 52mm black") to I. BLACK appears in uppercase as thats how it was first found in the cell.

[YellowLabPro]

Matt, I am embarrassed to say I never even saw the second black.
That is rather funny....:rofl:

I even think we talked about it...... Opps. Well if it is not too much to ask, I guess finding the second occurence of the color if it is not separated by a non-color word would be ideal....
But then Life is supposed to be good :thumb

Thanks for checking back in...

Doug

[mvidas]

Well if it is not too much to ask, I guess finding the second occurence of the color if it is not separated by a non-color word would be ideal.... I don't think I understand what you mean. Can you elaborate what you want, with example(s)?

[YellowLabPro]

I can upload the spreadsheet if this does not do it.

This entry:
SFW BLACK BIGHEAD 52mm black
I never saw the upper case "BLACK", I only saw the lower case black. This why I said I was embarrassed that I never saw it.

Does that clarify?

And also-


occurence of the color if it is not separated by a non-color word would be ideal....


The entry would look like this ideally,
Item Name: SFW BLACK BIGHEAD 52mm
Color: black

[mvidas]

Oh I understand.. you want to pull out the second instance of a color. No need to apologize though, just got your PM :)

I need to re-review the code.. I can't think of a good way to do this off the top of my head. Give me a couple minutes and I'll post back

[YellowLabPro]

Great, thanks Matt.

[mvidas]

Ok, I came up with a way to do this, though you'll need to decide if it is what you really want. If your item is "SFW BLACK/RED/BLUE BIGHEAD 52mm black".. column H will be "SFW", column I will be "BLACK/RED/BLUE BIGHEAD 52mm", and column M will be "black". All I'm doing is saying "if there are more than one group of color(s), get the last grouping". So if your cell had "SFW BLACK BIGHEAD RED 52mm BLUE" - the only color pulled from it will be "BLUE" and the BLACK BIGHEAD RED 52mm will be left in column I.
It will still act the same if only one instance of colors exist (ie "SFW BLACK BIGHEAD 52mm" - BLACK will still be put into column M)

Please make sure this is what you want, and how often you'll have two color groups in a cell. If it is what you want make the following changes.

Add to dim statements Dim RegC As Object
Change the With RegEx2 block (add .global=true, change .pattern): With RegEx2
.IgnoreCase = True
.Global = True
.Pattern = "(" & ColorString & ")(([/ ]?(" & ColorString & ")?)*)"
End With
Change the If RegEx2.Test(...) block (the If line through the Else line) to: If RegEx2.Test(RegM.SubMatches(1)) Then 'check to see if color in rest
Set RegC = RegEx2.Execute(RegM.SubMatches(1))
Set RegM2 = RegC.Item(RegC.Count - 1)
ColorData(i, 1) = RegM2.SubMatches(0) 'put color submatch into color array
If Len(Trim(RegM2.SubMatches(1))) > 0 Then 'put second color into color2 array
ColorData2(i, 1) = Trim("/" & Mid(RegM2.SubMatches(1), 2))
ColorData2(i, 1) = Replace(ColorData2(i, 1), " ", "/")
End If
TempArr(i, 2) = Replace(RegM.SubMatches(1), RegM2, "") 'fill col2
Else 'if no color in textMatt

[YellowLabPro]

Thanks Matt,
Sorry have not got back w/ you sooner, been a very hectic week.

[YellowLabPro]

Matt,
Super Bad! I mean Shaft Superfly Bad!
I placed some different configurations w/ color and it picked them all up and placed them in the proper column, I will run this over the next couple of weeks and test.
I dare not to jump in your code and change anything yet, there is something I would like to do to make it interactive w/ the situation. I manually can change the range in the following line-
Set SplitRG = .Range("I6", .Cells(.Rows.Count, "I").End(xlUp)) to run on a specific range, but would rather have it handle it automatically.
I think I have a way to qualify this, would you mind helping me make this change?

Thanks for everything,

Doug

[mvidas]

I manually can change the range in the following line-
Set SplitRG = .Range("I6", .Cells(.Rows.Count, "I").End(xlUp)) to run on a specific range, but would rather have it handle it automatically.
I think I have a way to qualify this, would you mind helping me make this change?Please explain what you mean.. how do you want to make it any more automatic? Didnt you say your range starts in column I at I6, and goes through the last filled cell in I?

[YellowLabPro]

Hi Matt,
Sure- I have found that I enter the data from multiple sheets on a regular basis. The program you wrote for me works w/ just one of these; "Eastern Skateboard Supply", - it is proprietary- and I use it a lot. But one thing that would help me from creating an error is an inputbox asking where the loop should begin. If I combine entering multiple sheets from two different companies say company A and then Eastern, I would want to run the program only on the range for the Eastern products.
Make better sense?
And btw: as I said in my last email- your program works fantastic-- thanks for all your help.

Best,

Doug

[mvidas]

have found that I enter the data from multiple sheets on a regular basis. The program you wrote for me works w/ just one of these; "Eastern Skateboard Supply", - it is proprietary- and I use it a lot. But one thing that would help me from creating an error is an inputbox asking where the loop should begin. If I combine entering multiple sheets from two different companies say company A and then Eastern, I would want to run the program only on the range for the Eastern products.
Make better sense? Kinda..? Not really, since I guess I'm not sure exactly how you're using it.
What are you wanting to have input box'ed? The sheet name? If so, just use a string variable with an input box, and substitute "Record Creator" with the string variable

The range within column I? Comment out the current "Set SplitRG ..." line and replace it with the lines in the same With block here:Sub DontCopyPasteThisLineItIsOnlyForTheVBACodeTagFormatting()
With Workbooks("TGSItemRecordCreatorMaster.xls") 'workbook, could use ActiveWorkbook
With .Worksheets("Record Creator") 'Set input range
' Set SplitRG = .Range("I6", .Cells(.Rows.Count, "I").End(xlUp))
On Error Resume Next
Set SplitRG = Application.InputBox("Please select cells to run this on", _
"Select range", Type:=8)
On Error GoTo 0
If SplitRG Is Nothing Then Exit Sub 'in case cancel is pressed
End With
With .Worksheets("Table") 'Set color table
Set ColorRG = .Range("A2", .Cells(.Rows.Count, 1).End(xlUp))
End With
End With
End Sub 'Dont copy/paste this line either

[YellowLabPro]

Thanks Matt,
I cannot test until later tonight, thanks. I will test....

Doug