Question

Update: sample file sample workbook

Problem: I would like to have something that can automatically

1. Search for the part number and revision. After the cell which contains “PART NUMBER” and “REVISION” is found, I need to get the values of below two cell (offset 1 column).

2. It will continue to look for the summary table

3. Put the summary table to a result sheet

4. Continue searching and repeat the process

There are:

• Possible of multiple parts number on the same sheet or just 1
• Only searching for the Sheet with starting name: “Search”

First Picture shows the structure of the file and the Second Picture shows the result

This will help a lot if it is doable. Please help me.

Update 1:
Logic as I think:
1. Write a module to search for all sheets starting with name “SEARCH”

2. Go to each sheet resulted from step 1 – to search .NEXT for PART NUMBER and REVISION to get all part number name and revision (addressing by offset(0,1))

3. Start to search for the summary table ==> It gets to complicated point

Answer 1

Is this what you are trying?

CODE

Option Explicit

Const SearchString As String = "PART NUMBER"

Dim wsO As Worksheet, WsI1 As Worksheet, WsI2 As Worksheet
Dim lRow As Long

Sub Sample()
    Set wsO = Sheets("Result")
    Set WsI1 = Sheets("SEARCH PAGE1")
    Set WsI2 = Sheets("SEARCH PAGE2")

    lRow = 2

    PopulateFrom WsI1
    PopulateFrom WsI2
End Sub

Sub PopulateFrom(ws As Worksheet)
    Dim aCell As Range, bCell As Range, cCell As Range, nmRng As Range, cl As Range
    Dim i As Long
    Dim ExitLoop As Boolean

    With ws
        Set aCell = .Cells.Find(What:=SearchString, LookIn:=xlValues, _
                    LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                    MatchCase:=False, SearchFormat:=False)

        If Not aCell Is Nothing Then
            Set bCell = aCell
            wsO.Range("A" & lRow).Value = aCell.Offset(1).Value
            wsO.Range("B" & lRow).Value = aCell.Offset(1, 3).Value
            i = 1
            Do
                If aCell.Offset(i) = "NAME" Then
                    Set nmRng = .Range(aCell.Offset(i), aCell.Offset(i).End(xlDown))
                     For Each cl In nmRng
                        If cl.Value <> "NAME" Then
                            If wsO.Range("A" & lRow).Value = "" Then
                                wsO.Range("A" & lRow).Value = wsO.Range("A" & lRow - 1).Value
                                wsO.Range("B" & lRow).Value = wsO.Range("B" & lRow - 1).Value
                            End If

                            wsO.Range("C" & lRow).Value = cl.Value
                            wsO.Range("D" & lRow).Value = cl.Offset(, 1).Value
                            wsO.Range("E" & lRow).Value = cl.Offset(, 2).Value
                            wsO.Range("F" & lRow).Value = cl.Offset(, 3).Value
                            lRow = lRow + 1
                        End If
                     Next
                    Exit Do
                End If
                i = i + 1
            Loop

            Do While ExitLoop = False
                Set aCell = .Cells.FindNext(After:=aCell)

                If Not aCell Is Nothing Then
                    If aCell.Address = bCell.Address Then Exit Do
                    wsO.Range("A" & lRow).Value = aCell.Offset(1).Value
                    wsO.Range("B" & lRow).Value = aCell.Offset(1, 3).Value
                    i = 1
                    Do
                        If aCell.Offset(i) = "NAME" Then
                            Set nmRng = .Range(aCell.Offset(i), aCell.Offset(i).End(xlDown))
                             For Each cl In nmRng
                                If cl.Value <> "NAME" Then
                                    If wsO.Range("A" & lRow).Value = "" Then
                                        wsO.Range("A" & lRow).Value = wsO.Range("A" & lRow - 1).Value
                                        wsO.Range("B" & lRow).Value = wsO.Range("B" & lRow - 1).Value
                                    End If
                                    wsO.Range("C" & lRow).Value = cl.Value
                                    wsO.Range("D" & lRow).Value = cl.Offset(, 1).Value
                                    wsO.Range("E" & lRow).Value = cl.Offset(, 2).Value
                                    wsO.Range("F" & lRow).Value = cl.Offset(, 3).Value
                                    lRow = lRow + 1
                                End If
                             Next
                            Exit Do
                        End If
                        i = i + 1
                    Loop
                Else
                    ExitLoop = True
                End If
            Loop
        End If
    End With
End Sub

SAMPLE FILE

i.minus.com/1338702873/20yZJWFxgv9Egtd4klNOBg/dtst1Y4ckv86f/Sample.xlsm