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?
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

What 2 criteria do you want to remove duplicates by?
andreyman3d2kAuthor Commented:
Awesome! Thank you very much.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.