Pls help on VBA code: Table to list etc

[mrchonginhk]

Hi I have a table like this

VBAAssignment1.xls
	A	B	C	D	E
1	Q2
2		Col1	Col2	Col3	Col4
3	Row1	1	2	3	4
4	Row2	5	6	7	8
5	Row3	9	10	11	12
6	Row4	13	14	15	16
7	Row5	17	18	19	20
Q2

Then, I need to write a FUNCTION called
Tableonly that returns a table as range without extraneous emoty rows and column. But, if user clicks a cell outside table, return only cell where user has clicked. Hints from my boss: Use COUNTA and range.EntireRow.

Then using above write program that selects only data from table (Bosss say use range.size method)

Then write another program select only col heading
Then write another select only row headings

Hence, write a program converting the table in a list. ie the table above should becomes:-

VBAAssignment1.xls
	G	H	I	J
6	Row1	Col1	1
7	Row2	Col1	5
8	Row3	Col1	9
9	Row4	Col1	13
10	Row5	Col1	17
11	Row1	Col2	2
12	Row2	Col2	6
13	Row3	Col2	10
14	Row4	Col2	14
15	Row5	Col2	18
16	Row1	Col3	3
17	Row2	Col3	7
18	Row3	Col3	11
19	Row4	Col3	15
20	Row5	Col3	19
21	Row1	Col4	4
22	Row2	Col4	8
23	Row3	Col4	12
24	Row4	Col4	16
25	Row5	Col4	20
Q2

Pls help. Any one part will help ... Thanks.

 

[jindon]

Hi

would you like to try this one, too?
in Stardard module or ThisWorkbook module

Sub trans_P()
Dim Sr As Long, Lr As Long, Sc As Integer, Lc As Integer, nR As Long, nC As Integer
Dim a(), b(), i As Integer, ii As Long, iii As Long, z As Long
With Sheets("sheet1").Range("b3").CurrentRegion
    Sr = .Row
    nR = .Rows.Count
    Sc = .Column
    nC = .Columns.Count
End With
    Lr = Sr + nR - 1
    Lc = Sc + nC - 1
    ReDim a(Sr To Lr, Sc To Lc)
    ReDim b(Sr To nR * nC + Sr + 1, Sc To Lc)
With Sheets("sheet1")
    .Columns("j:l").Clear
    a = .Range("b3").CurrentRegion.Value
    iii = -1
    For i = Sc + 1 To Lc
        iii = iii + 1
        z = iii * (nR - 1)
        For ii = Sr To Lr - 1
            b(ii + z, 1) = a(ii, 1)
            b(ii + z, 2) = a(Sr - 1, i)
            b(ii + z, 3) = a(ii, i)
        Next
    Next
    With .Range("j2").Resize((nR - 1) * (nC - 1), 3)
        .Value = b
        .BorderAround Weight:=xlThin
        .Borders(xlInsideHorizontal).Weight = xlThin
        .Borders(xlInsideVertical).Weight = xlThin
    End With
End With
Erase a, b
End Sub

then following code onto sheet module

Dim base As Range
Private Sub Worksheet_Activate()
    Set base = Me.Range("a3").Cells(1, 1)
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Intersect(Target, Me.Range("a3").CurrentRegion) Is Nothing Then
        base.Activate
    Else
        Set base = Target
    End If
End Sub

rgds,
jindon