Find header, locate intersection return row heading to another sheet

[amolvijay]

Dear Experts..

Request for help. Below mentioned please find worksheet.

Sheet 1 have data comprising of Program name, commodity and engineer working on the program and commodity.

From the table I wish to extract Commodity and engineer working on it and paste it to respective Program tab. "LE" is the intersection point of engineer and commodity for that particular program...

Please support..

Workbook have Sheet1, Pro1, Pro2, Pro3, Pro4....worksheets

[TABLE="width: 799"]
<TBODY>[TR]
[TD][/TD]
[TD]Pro1</SPAN>[/TD]
[TD]Pro1</SPAN>[/TD]
[TD]Pro2</SPAN>[/TD]
[TD]Pro2</SPAN>[/TD]
[TD]Pro2</SPAN>[/TD]
[TD]Pro3</SPAN>[/TD]
[TD]Pro3</SPAN>[/TD]
[TD]Pro3</SPAN>[/TD]
[TD]Pro3</SPAN>[/TD]
[TD]Pro3</SPAN>[/TD]
[TD]Pro4</SPAN>[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Com1</SPAN>[/TD]
[TD]Com2</SPAN>[/TD]
[TD]Com1</SPAN>[/TD]
[TD]Com3</SPAN>[/TD]
[TD]Com4</SPAN>[/TD]
[TD]Com2</SPAN>[/TD]
[TD]Com1</SPAN>[/TD]
[TD]Com5</SPAN>[/TD]
[TD]Com6</SPAN>[/TD]
[TD]Com4</SPAN>[/TD]
[TD]Com8</SPAN>[/TD]
[/TR]
[TR]
[TD]AA</SPAN>[/TD]
[TD] [/TD]
[TD]LE[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]AB</SPAN>[/TD]
[TD]LE[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD]LE[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]AC</SPAN>[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD]LE[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]AD</SPAN>[/TD]
[TD] [/TD]
[TD]LE[/TD]
[TD]LE[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD]LE[/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]AE</SPAN>[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD]LE[/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]AF</SPAN>[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD]LE[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]AG</SPAN>[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD]LE[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD]LE[/TD]
[/TR]
[TR]
[TD]AH</SPAN>[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD]LE[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
</TBODY><COLGROUP><COL><COL span=2><COL><COL span=8></COLGROUP>[/TABLE]

[TABLE="class: grid, width: 144"]
<COLGROUP><COL style="WIDTH: 48pt" span=3 width=64><TBODY>[TR]
[TD="width: 64, bgcolor: transparent"]Prog1[/TD]
[TD="width: 64, bgcolor: transparent"]Prog1[/TD]
[TD="width: 64, bgcolor: transparent"]Prog1[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]Com1[/TD]
[TD="bgcolor: transparent"]Com2[/TD]
[TD="bgcolor: transparent"]Com2[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]AB[/TD]
[TD="bgcolor: transparent"]AA[/TD]
[TD="bgcolor: transparent"]AD[/TD]
[/TR]
</TBODY>[/TABLE]

 

[Stridhan]

Im a vba beginner so..
Ive added "Engineer" and "Commodity" as headers on each PRO-sheet.

Try below in a copy

Sub extractProg()

Dim myArray() As Variant
Dim x, i, nr As Integer

Sheets("Sheet1").Activate
myArray = Range("A1").CurrentRegion

Application.ScreenUpdating = False
For x = 1 To UBound(myArray, 1)
    For i = 1 To UBound(myArray, 2)
        If myArray(x, i) = "LE" Then
            Sheets(myArray(1, i)).Activate
            If Range("A2") = "" Then
                nr = 2
            Else
                nr = Cells(Rows.Count, 1).End(xlUp).Row + 1
            End If
        With Range("A" & nr)
            .Value = myArray(x, 1)
            .Offset(0, 1) = myArray(2, i)
        End With
        End If
    Next i
Next x

Erase myArray
Sheets("Sheet1").Activate
Application.ScreenUpdating = True
End Sub

 

[Stridhan]

realized that you can delete red marked code. Unnecessary code.
just keep nr = Cells(Rows.Count, 1).End(xlUp).Row + 1

Its learning by doing

  [COLOR=#ff0000]If Range("A2") = "" Then[/COLOR]
                [COLOR=#ff0000]nr = 2
            Else[/COLOR]
                nr = Cells(Rows.Count, 1).End(xlUp).Row + 1
            [COLOR=#ff0000]End If[/COLOR]

 

[amolvijay]

Hi Stridha,

Thanks for your efforts. I m getting error "Subscript Out of Range".

please help.

 

[Stridhan]

Are your sheets named Sheet1, Pro1, Pro2 and so on?
Whats the range of your table?

 

[amolvijay]

HI Stridhan,

Yes, I do have worksheets named Sheet1, Pro1, Pro2. I didnt get table range. Are you referring to the input table on sheet1? Do I have to make it named range?

 

[amolvijay]

Hi Stridhan,

Thank you very much. Your code worked.....appreciated your time and efforts.

 

[Stridhan]

you saw my PM ?