Macro for data manipulation

Hey all,

Hope you can help me out, I'm having a bit of a headache with the following. I'm fairly new to vb in Excel and have a few macros so far to manipulate a raw data feed to get it into a format my system can read. I'm stuck on a couple of bits.

1) To remove variant information found in a couple of columns from the model name in another column. i.e.
Cell F2 contains 'SIS SP41 outer gear casing with silicon grease, black 4 mm (10 metre roll)'
Cell B2 & C2 contain 'black' and '4 mm'
I want F2 to say 'SIS SP41 outer gear casing with silicon grease, (10 metre roll)' and clear cells B2 & C2

2) To clear duplicates data from cells in column F but keeping the first instance of the data in the row. i.e.
Row 2,3,4,5,6 did contain:
SIS SP41 outer gear casing with silicon grease, black 4 mm (10 metre roll)
SIS SP41 outer gear casing with silicon grease, grey 4 mm (10 metre roll)
SIS SP41 outer gear casing with silicon grease, white 4 mm (10 metre roll)
SIS SP41 outer gear casing with silicon grease, blue, 4 mm (10 metre roll)
SIS SP41 outer gear casing with silicon grease, red, 4 mm (10 metre roll)
SIS SP41 outer gear casing with silicon grease, yellow, 4 mm (10 metre roll)

but now based on 1) above row 2,3,4,5,6 now contains 'SIS SP41 outer gear casing with silicon grease, (10 metre roll)' on every row

I want to clear the duplicate cells on every recurring instance of 'SIS SP41 outer gear casing with silicon grease, (10 metre roll)' without deleting the row.

Please see attached file for example. Original data is the top table while the desired outcome is the bottom table.

Many Thanks
Dave

Here is some code to strip the variants out. I had to tweak things a bit as your descriptions and variants aren't quite consistent. It doesn't work for the first four items in you example because the text spacing in the product model doesn't match the text spacing in the variantSize:

Option Compare Text

Public Sub StripVariants()

    Call StripVariant(Worksheets("Sheet1").Range("C:C"), Worksheets("Sheet1").Range("F:F"))
    Call StripVariant(Worksheets("Sheet1").Range("D:D"), Worksheets("Sheet1").Range("F:F"))

End Sub

Public Sub StripVariant(ByVal rngVariant As Excel.Range, ByVal rngText As Excel.Range)

    Dim arrVariant          As Variant
    Dim arrText             As Variant

    Dim lngLastRow          As Long
    Dim lngRow              As Long
    Dim intCol              As Integer
    Dim intPos              As Integer

    intCol = rngVariant.Column
    lngLastRow = rngVariant.Parent.Columns(intCol).Find(What:="*", After:=Cells(1, intCol), _
        SearchOrder:=xlByRows, SearchDirection:=xlPrevious, _
        LookAt:=xlPart, LookIn:=xlValues).Row
    arrVariant = rngVariant.Cells(1, 1).Offset(1, 0).Resize(lngLastRow - 1, 1).Value
    arrText = rngText.Cells(1, 1).Offset(1, 0).Resize(lngLastRow - 1, 1).Value

    For lngRow = LBound(arrVariant) To UBound(arrVariant)
        If Len(arrVariant(lngRow, 1)) > 0 Then
            intPos = InStr(1, arrText(lngRow, 1), Trim(arrVariant(lngRow, 1)))
            If intPos > 0 Then
                arrText(lngRow, 1) = Left(arrText(lngRow, 1), intPos - 1) _
                    & Mid(arrText(lngRow, 1), intPos + Len(arrVariant(lngRow, 1)))
                If Mid(arrText(lngRow, 1), intPos - 1, 2) = "  " Then
                    arrText(lngRow, 1) = Left(arrText(lngRow, 1), intPos - 1) _
                        & Mid(arrText(lngRow, 1), intPos + 1)
                ElseIf Mid(arrText(lngRow, 1), intPos - 1, 3) = " , " Then
                    arrText(lngRow, 1) = Left(arrText(lngRow, 1), intPos - 2) _
                        & Mid(arrText(lngRow, 1), intPos + 1)
                End If
            End If
        End If
    Next lngRow

    rngText.Cells(2, 1).Resize(UBound(arrText), 1).Value = arrText

End Sub

To use it, go to the VBA IDE (alt-F11), insert a new module and paste in the code. You may need to change the StripVariants module to point to the right sheets and columns in your production worksheet, but it works in the example. With your cursor in the StripVariants procedure, just press F5 to run it (for testing, I'm sure you'll want a button somewhere later).

I'll work on the second part tomorrow. But, in preparation for that, would you want the data sorted by column F before stripping out the duplicates?

Hey thats brilliant thanks. Not had a chance to put it in my larger spreadsheet yet but I'll try it today.

Unfortunately my supplier data feeds are inconsistent and that is half my problem. Trying to get around those issues as well. Maybe it would work if we forced a column to be consistent by either removing or inserting spaces based on rules?

The 2nd part doesn't need column F sorted before data stripping as my sheet is already sorted in a particular order. If you could provide the 2nd part that would be amazing!!!



Many Thanks
Dave

Hi Wallyeye,

I have tried that code changing the column and sheet name details to fit in with my original spreadsheet but for some reason I can't get it to work although it works in the example spreadsheet.

I have attached the actual spreadsheet with just the first few lines, and I wonder if we can make use of the last column. It contains a unique identifier that ties up all the variants together.

The spreadsheet will eventually be an import file for my website so my project is to take a raw supplier feed and automate it to process the data into a format my system can import.

It isn't the end of the earth if the productModel field has not had the variant info stripped from it (this can be optimised once it is in my system) as long as each cell on the proceeding rows are blank as this is the really important bit. This is where I thought the last column would come in handy.

For the productModel column I had an idea that a script could look at a group of variant products by looking at the last column, then comparing the data in the productModel column to remove any information that they don't have in common. Thought this way would possibly be easier than trying to look up the actual variant columns for matching data.

Anyway, hope this makes sense!

Many Thanks
Dave

I'm not real happy with my solution to the ambigous variants, but it will work over time. I set up a VariantMap sheet, with the original variant and a product text version tied together in a table. Over time, you can build up this table to make the process work smoothly, but it will take a bit to get it. I know it would be possible to build up some fuzzy logic to accommodate the almost matches, but that is a bit more than I would want to get into here.

I suspect your changes to the StripVariants module weren't quite right, once I put the right sheet and columns in it worked fine:

Products.xls

Your dedupe works an absolute treat. 20,000 lines of data deduped in a flash! Amazing thank you very much.

The whole point of the StripVariants module was so that the dedupe could work properly. But I think I might have a solution we could work on.... what if we could take column N and with column G copy down the first cell from the first variant to the last variant? This would mean in the product.xls file above that we have 4 cells duplicated as 'BB-5500 105 bottom bracket 68-109 mm' and then 8 cells duplicated as 'SIS SP41 outer gear casing with silicon grease, Black 4 mm (10 metre roll)'. Do you think this is possible?

After this then the dedupe script would run neatly doing its job. Its no big deal that productModel contains a variant at the end as this field need manually optimised product by product once in my system anyway so for example manually deleting '68-109 mm' from the end of productModel is fine. However to reduce this manual labour process there is no reason why we can't run the StripVariants module to strip what it can.



All the best
Dave

Actually, it is even easier than that:

Change StripVariants:

Public Sub StripVariants()

    Call StripVariant(Worksheets("Data").Range("D:D"), Worksheets("Data").Range("G:G"))
    Call StripVariant(Worksheets("Data").Range("E:E"), Worksheets("Data").Range("G:G"))

    Call DeDupe(Worksheets("Data").Range("G:G"), Worksheets("Data").Range("N:N"))

End Sub

and tweak DeDupe:

Public Sub DeDupe(ByVal rngText As Excel.Range, ByVal rngCompare As Excel.Range)

    Dim arrText             As Variant
    Dim arrCompare          As Variant

    Dim lngLastRow          As Long
    Dim lngRow              As Long
    Dim strCompare          As String

    intCol = rngText.Column
    lngLastRow = rngText.Parent.Columns(intCol).Find(What:="*", After:=Cells(1, intCol), _
        SearchOrder:=xlByRows, SearchDirection:=xlPrevious, _
        LookAt:=xlPart, LookIn:=xlValues).Row
    arrText = rngText.Cells(1, 1).Offset(1, 0).Resize(lngLastRow - 1, 1).Value
    arrCompare = rngCompare.Cells(1, 1).Offset(1, 0).Resize(lngLastRow - 1, 1).Value

    strCompare = arrCompare(1, 1)
    For lngRow = LBound(arrText) + 1 To UBound(arrText)
        If arrCompare(lngRow, 1) = strCompare Then
            arrText(lngRow, 1) = ""
        Else
            strCompare = arrCompare(lngRow, 1)
        End If
    Next lngRow

    rngText.Cells(2, 1).Resize(UBound(arrText), 1).Value = arrText

    Set rngText = Nothing
    Set rngCompare = Nothing

End Sub

This is amazing and so close!!

I've attached more lines of data to the spreadsheet as the above script works great until about row 27 then throws up an error during the variant stripping. I'm not sure what is causing it. Any ideas?

Thanks
Dave

A blank in D27 caused the issue. To get around it:

    For lngRow = LBound(arrVariant) To UBound(arrVariant)
        If Len(Trim(arrVariant(lngRow, 1))) > 0 Then
            intPos = InStr(1, arrText(lngRow, 1), Trim(arrVariant(lngRow, 1)))

Trim the variant before checking its length.

So far so good until it gets to the products that don't have a Variant Grouping.

Some of the data in the spreadsheet doesn't have a Variant Grouping code in Column N, so when the script is run the productModel name is removed. How do we modify the script to stop stripping the variants on these lines of data?

I think this is my last problem and the thread is solved. I can't thank you enough!

In the DeDupe procedure:

        If arrCompare(lngRow, 1) = strCompare Then
            If strCompare > "" Then
                arrText(lngRow, 1) = ""
            End If
        Else

or

        Else
            If arrCompare(lngRow, 1) > "" Then
                strCompare = arrCompare(lngRow, 1)
            End If
        End If

Either one will work.

Perfect!!!!

Thanks
Dave