Update Main Record and Remove Duplicates

[CSC2100]

I have a spreadsheet with a list of items for a company inventory. For each item there is a row that has all the details related to the item. There is also a "sub-row" for each item that only has the item number and current costs and pricing for the item.

I have a 2-part task that I am having trouble with:

First: I have to essentially update the "main row" with the updated cost and pricing info from the "sub-row" wherever one would exist and...

Second: Delete the duplicate row for the item (the one with less info).

My production file has thousands of rows, but I have created a sample file if anyone can help me with getting my task accomplished. I am new to these forums, so I'm not sure how I could attach the sample file to this post, but if someone could tell me how to do that I will provide it. In the mean time I will just insert a screenshot.

 

[CSC2100]

Bump

 

[jindon]

Can you post the desired result out of your sample data ?

BTW, placing blank column(s)/Row(s) between the data area is no good.

 

[CSC2100]

Thanks for your reply...

I know that it isn't good practice to have the empty columns in the data set, however that is how the data was exported from the system where I get it. We can/will remove those empty columns if needed.

Here are my desired results:

 

[jindon]

Let's see if this works for you

Sub test()
Dim myAreas As Areas, dic As Object, x As Long
Dim i As Long, ii As Long, iii As Long
Set dic = CreateObject("Scripting.Dictionary")
dic.CompareMode = vbTextCompare
On Error Resume Next
Rows(1).SpecialCells(4).EntireColumn.Delete
With Range("a1").CurrentRegion
    x = .Columns.Count - 2
    With .Resize(.Rows.Count - 1, 1).Offset(1, .Columns.Count + 2)
        .Formula = "=if(and(a1<>"""",a2<>""""),1,"""")"
        .SpecialCells(-4123, 1).EntireRow.Insert xlShiftDown
        .ClearContents
    End With
    Set myAreas = .Columns(2).SpecialCells(2).Areas
    On Error GoTo 0
    If myAreas Is Nothing Then Exit Sub
    For i = 2 To myAreas.Count
        If myAreas(i).Rows.Count > 1 Then
            For ii = 1 To myAreas(i).Rows.Count
                If Not dic.exists(myAreas(i).item(ii).Value) Then
                    dic.add myAreas(i).item(ii).Value, ii
                Else
                    For iii = 0 To x
                        If myAreas(i).item(ii).Offset(,iii).Value <> "" Then
                            myAreas(i)(dic(myAreas(i).item(ii).Value).Offset(,iii).Value = _
                            myAreas(i).item(ii).Offset(,iii).Value
                            myAreas(i).item(ii).Offset(,iii).ClearContents
                        End If
                    Next
                End If
            Next
        End If
        dic.removeall
    Next
    .Columns(2).SpecialCells(4).EntireRow.Delete
End With
End Sub

 

[CSC2100]

Thanks for your reply...

Forgive me for being dumb, but I am having trouble using the code that you sent.

In Excel 2007, I went into the VBA editor and added a new module with the code you have provided. The problem is that I get an error inside the if stmt section that I have copied below I get an error at the end of the one line that is wrapped...not sure why.

If myAreas(i).item(ii).Offset(,iii).Value <> "" Then
                            myAreas(i)(dic(myAreas(i).item(ii).Value).Offset(,iii).Value = _
                            myAreas(i).item(ii).Offset(,iii).Value
                            myAreas(i).item(ii).Offset(,iii).ClearContents
                        End If

 

[CSC2100]

After reviewing the code, it appears that there is an end parenthesis missing in the second line of the if stmt.

myAreas(i)(dic(myAreas(i).Item(ii).Value).Offset(, iii).Value = _
myAreas(i).Item(ii).Offset(, iii).Value

The error is "Compile Error: expected list separator or )"

 

[CSC2100]

Alright...I did some testing of my own with the code and added the parenthesis like below (in red):

If myAreas(i).Item(ii).Offset(, iii).Value <> "" Then
      myAreas(i)(dic(myAreas(i).Item(ii).Value)[COLOR=Red])[/COLOR].Offset(, iii).Value = _
      myAreas(i).Item(ii).Offset(, iii).Value
      myAreas(i).Item(ii).Offset(, iii).ClearContents
End If

Below is a screenshot of the result. The first "Oven" item should have had a Cost = $5186.00 and Price = $8000.00 and the first "Cutlery" item should have had a Cost = $399.00 and Price = $550.00 when we were done. It looks like we are part of the way there with removing the correct lines, however the Cost/Price updates are not working so far.

 

[jindon]

How about

Sub test()
Dim myAreas As Areas, dic As Object, x As Long, y As Long
Dim i As Long, ii As Long, iii As Long
Set dic = CreateObject("Scripting.Dictionary")
dic.CompareMode = vbTextCompare
On Error Resume Next
Rows(1).SpecialCells(4).EntireColumn.Delete
With Range("a1").CurrentRegion
    x = .Columns.Count - 2
    With .Resize(.Rows.Count - 1, 1).Offset(1, .Columns.Count + 2)
        .Formula = "=if(and(a1<>"""",a2<>""""),1,"""")"
        .SpecialCells(-4123, 1).EntireRow.Insert xlShiftDown
        .ClearContents
    End With
    Set myAreas = .Columns(2).SpecialCells(2).Areas
    On Error GoTo 0
    If myAreas Is Nothing Then Exit Sub
    For i = 2 To myAreas.Count
        If myAreas(i).Rows.Count > 1 Then
            For ii = 1 To myAreas(i).Rows.Count
                If Not dic.exists(myAreas(i).item(ii).Value) Then
                    dic.add myAreas(i).item(ii).Value, ii
                Else
                    y = dic(myAreas(i).item(ii).Value)
                    For iii = 0 To x
                        If myAreas(i).item(ii).Offset(,iii).Value <> "" Then
                            myAreas(i).item.(dic(y)).Offset(,iii).Value = _
                            myAreas(i).item(ii).Offset(,iii).Value
                            myAreas(i).item(ii).Offset(,iii).ClearContents
                        End If
                    Next
                End If
            Next
        End If
        dic.removeall
    Next
    .Columns(2).SpecialCells(4).EntireRow.Delete
End With
End Sub

 

[CSC2100]

I get a compile error where I have highlighted below in red. The error states that it expected:identifier or bracketed expression.

If myAreas(i).Item(ii).Offset(, iii).Value <> "" Then
     myAreas(i).Item.(dic(y)).Offset(,iii).Value = _
     myAreas(i).Item(ii).Offset(, iii).Value
     myAreas(i).Item(ii).Offset(, iii).ClearContents
End If