Excel 2007 Macro to perform several tasks


I have a program that puts out some data tables on a sheet with some useless data in-between. (Example is sheet "test" in attached file -- it only shows two data tables, but could be more). I need to consolidate those tables into a single table, get rid of the data in-between, and add a few columns.
I also need to remove duplicates by two criteria, and give a count of all the duplicates removed.

The other sheet, "Result" shows what the final output should be, and has a list of all the things that have to happen.

I tried a bunch of stuff with macro recorder, came close, but not cigar (and it was a mess). Would be grateful if someone with VBA skills could help.

Thank you very much, in advance!

Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

What 2 criteria do you want to remove duplicates by?
i believe this will do it

1. Reads the values in ActiveSheet ("test") for "p/n:"
2. If its a duplicate it will increase the Quantity number
3. Else it will Add a new row

Make sure the ActiveSheet holds the data

Sub ConsolidateData()
Dim wb As Workbook

Dim wsMaster As Worksheet
Dim wsConsol As Worksheet

Dim rng1 As Range
Dim rng2 As Range
Dim rngRow As Range

Dim col As Collection
Dim str As String

Dim lCount As Long

'Collection to get COUNTIF value
Set col = New Collection

'Get Active workbook
Set wb = ActiveWorkbook

'Get sheets
Set wsMaster = wb.ActiveSheet
'Set wsMaster = wb.Sheets("MySheetName")
Set wsConsol = wb.Sheets.Add

'Get range of Main Data
Set rng1 = wsMaster.UsedRange

'Get Consolidated Range
Set rng2 = wsConsol.Range("A1:E1")

'Set headings
rng2.Value = Array("P/N", "Page", "Revision", "Quantity", "Unit")

Set rng2 = rng2.Offset(1)

For Each rngRow In rng1.Rows
    If LCase(Left(rngRow.Cells(1).Value, 4)) = "p/n:" Then
      'Determine Duplicates
      On Error Resume Next
      str = rngRow.Cells(1).Value & "|" & rngRow.Cells(2).Value
      col.Add str, str
      'Duplicate Value
      If Err.Number <> 0 Then
        'Loop all used cells in Consolidation Sheet to find value
        For i = 2 To wsConsol.UsedRange.Rows.Count
          If wsConsol.Cells(i, 1).Value = UCase(Trim(Replace(LCase(rngRow.Cells(1).Value), "p/n:", ""))) And _
                wsConsol.Cells(i, 2).Value = rngRow.Cells(2).Value Then
            'Increase value by 1
            wsConsol.Cells(i, 4).Value = CLng(wsConsol.Cells(i, 4).Value) + 1
            'Exit loop (No need to keep searching
            Exit For
          End If
        Next i
      'Not a Duplicate Value
        'Remove "p/n:" from string
        rng2.Cells(1).Value = UCase(Trim(Replace(LCase(rngRow.Cells(1).Value), "p/n:", "")))
        'Page number
        rng2.Cells(2).Value = rngRow.Cells(2).Value
        'Count of Duplicates
        'leave as 1 by default, will edit in other part of IF statement
        rng2.Cells(4).Value = 1
        rng2.Cells(5).Value = "Ea"
        Set rng2 = rng2.Offset(1)
      End If
      On Error GoTo 0

    End If
Next rngRow

End Sub

Open in new window


Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
andreyman3d2kAuthor Commented:
Awesome! Thank you very much.

It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.