finding cells with value in table and copy Row & column Header & cell Value in new sheet

[Ghadir]

Hello
I'm totally new in excel and trying to learn macro, I searched the forum and didn't find the correct macro but now I need a macro to search a table for cells with value, then copy row and column headers and the cell value in a row in new sheet. as example:
[TABLE="width: 500"]
<tbody>[TR]
[TD]city[/TD]
[TD]1[/TD]
[TD]2[/TD]
[TD]3[/TD]
[TD]4[/TD]
[/TR]
[TR]
[TD]A[/TD]
[TD][/TD]
[TD]x[/TD]
[TD][/TD]
[TD]z[/TD]
[/TR]
[TR]
[TD]B[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]C[/TD]
[TD]y[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]D[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]w[/TD]
[/TR]
</tbody>[/TABLE]

output:
[TABLE="width: 500"]
<tbody>[TR]
[TD]A[/TD]
[TD]2[/TD]
[TD]x[/TD]
[/TR]
[TR]
[TD]A[/TD]
[TD]4[/TD]
[TD]z[/TD]
[/TR]
[TR]
[TD]C[/TD]
[TD]1[/TD]
[TD]y[/TD]
[/TR]
[TR]
[TD]D[/TD]
[TD]4[/TD]
[TD]w[/TD]
[/TR]
</tbody>[/TABLE]

thanks

 

[MickG]

Try this for results on sheet2, starting "A2".

[COLOR="Navy"]Sub[/COLOR] MG24Nov10
[COLOR="Navy"]Dim[/COLOR] ray [COLOR="Navy"]As[/COLOR] Variant, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
 ray = ActiveSheet.Cells(1).CurrentRegion
   ReDim nray(1 To UBound(ray, 1), 1 To 3)

[COLOR="Navy"]For[/COLOR] n = 2 To UBound(ray, 1)
  [COLOR="Navy"]For[/COLOR] Ac = 2 To UBound(ray, 2)
    [COLOR="Navy"]If[/COLOR] ray(n, Ac) <> "" [COLOR="Navy"]Then[/COLOR]
        c = c + 1
        nray(c, 1) = ray(n, 1)
        nray(c, 2) = ray(1, Ac)
        nray(c, 3) = ray(n, Ac)
    [COLOR="Navy"]End[/COLOR] If
   [COLOR="Navy"]Next[/COLOR] Ac
[COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]With[/COLOR] Sheets("Sheet2").Range("A2").Resize(c, 3)
    .Value = nray
    .Borders.Weight = 2
    .Columns.AutoFit
    .HorizontalAlignment = xlCenter
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[Ghadir]

thanks Mick, but this just work with 2 columns. once No. of coluns is more than 2 it stop working with error "subscript out of range" for line 9 [nray(c, 1)= ray(n, 1)}

 

[Ghadir]

thanks Mick, but this just work with 2 columns. once No. of coluns is more than 2 it stop working with error "subscript out of range" for line 9 [nray(c, 1)= ray(n, 1)}

i found the source of error.it caused by dimension of nray, the problem is the number of defined rows for nray by using Ubound function which the max number of rows will be equal to number of rows of ray not the amount of cells in the range. i would be appreciated if you let me know the best way to define count of cells as array dimension.

 

[MickG]

Try changing the array "nRay" dimensioning to the following:-

ReDim nray(1 To UBound(ray, 1[COLOR="#FF0000"][B])*uboound(ray,2), [/B][/COLOR]1 To 3)