VBA macro to find results

[saurabhlotankar]

Hello Everyone,

I have pasted a table below. From that table i want to extract codes(mentioned in column A) for each country with "Yes" along with country name and date mentioned at the top of each country.

this is not possible with formulas. Can anyone please help with me a vba code or macro to get this done. It will be really hekpful.

Thanks a lot.

		11/28/2015	11/2/2015	4/10/2015	9/4/2015	4/27/2015	6/2/2015	4/30/2015
Code	Name	US	UK	Germany	Turkey	Thailand	India	Sri Lanka
36915	q	Yes	No	No	Yes	Yes	No	No
29417	w	Yes	Yes	Yes	No	No	No	Yes
22928	e	No	Yes	No	No	No	No	Yes
13201	r	Yes	Yes	No	No	No	Yes	No
50053	t	Yes	No	No	Yes	Yes	Yes	Yes
78369	y	Yes	Yes	No	Yes	Yes	No	No
59904	u	No	Yes	Yes	Yes	Yes	No	Yes
49654	i	No	Yes	Yes	Yes	No	No	No
51644	o	Yes	No	No	Yes	Yes	No	No
54172	p	No	Yes	Yes	No	Yes	Yes	Yes
76530	l	Yes	Yes	No	No	No	No	No
79272	k	No	Yes	Yes	Yes	No	Yes	Yes
48911	j	No	Yes	Yes	No	No	No	Yes
70934	h	No	No	No	Yes	Yes	Yes	No
8767	g	No	Yes	Yes	No	No	No	No
8961	f	Yes	Yes	Yes	No	Yes	No	No
26324	d	Yes	No	Yes	Yes	Yes	Yes	No
61679	s	Yes	Yes	No	Yes	No	Yes	Yes
29962	a	Yes	Yes	No	No	Yes	No	Yes
72390	z	No	Yes	No	Yes	No	No	No
22474	x	Yes	No	Yes	Yes	No	Yes	No
27881	c	No	Yes	Yes	No	Yes	No	No
10897	v	Yes	Yes	Yes	No	Yes	No	Yes
63988	b	No	No	Yes	Yes	Yes	Yes	No
68620	n	No	No	Yes	Yes	No	Yes	Yes
36840	m	No	No	Yes	Yes	Yes	Yes	No

<colgroup><col><col><col><col span="2"><col><col><col><col></colgroup><tbody>
</tbody>

Result should look like this:

Code	Name	Country	date
36915	q	US	11/28/2015
29417	w	US	11/28/2015
13201	r	US	11/28/2015
50053	t	US	11/28/2015
78369	y	US	11/28/2015
51644	o	US	11/28/2015
76530	l	US	11/28/2015
8961	f	US	11/28/2015
26324	d	US	11/28/2015
61679	s	US	11/28/2015
29962	a	US	11/28/2015
22474	x	US	11/28/2015
10897	v	US	11/28/2015
29417	w	UK	11/2/2015
22928	e	UK	11/2/2015
13201	r	UK	11/2/2015
78369	y	UK	11/2/2015
59904	u	UK	11/2/2015
49654	i	UK	11/2/2015
54172	p	UK	11/2/2015
76530	l	UK	11/2/2015
79272	k	UK	11/2/2015
48911	j	UK	11/2/2015
8767	g	UK	11/2/2015
8961	f	UK	11/2/2015
61679	s	UK	11/2/2015
29962	a	UK	11/2/2015
72390	z	UK	11/2/2015
27881	c	UK	11/2/2015
10897	v	UK	11/2/2015

<colgroup><col span="3"><col></colgroup><tbody>
</tbody>

 

[Momentman]

Data would look like this

Excel 2010
	A	B	C	D	E	F	G	H	I
1			11/28/2015	11/02/2015	04/10/2015	09/04/2015	4/27/2015	06/02/2015	4/30/2015
2	Code	Name	US	UK	Germany	Turkey	Thailand	India	Sri Lanka
3	36915	q	Yes	No	No	Yes	Yes	No	No
4	29417	w	Yes	Yes	Yes	No	No	No	Yes
5	22928	e	No	Yes	No	No	No	No	Yes
6	13201	r	Yes	Yes	No	No	No	Yes	No
7	50053	t	Yes	No	No	Yes	Yes	Yes	Yes
8	78369	y	Yes	Yes	No	Yes	Yes	No	No
9	59904	u	No	Yes	Yes	Yes	Yes	No	Yes
10	49654	i	No	Yes	Yes	Yes	No	No	No
11	51644	o	Yes	No	No	Yes	Yes	No	No
12	54172	p	No	Yes	Yes	No	Yes	Yes	Yes
13	76530	l	Yes	Yes	No	No	No	No	No
14	79272	k	No	Yes	Yes	Yes	No	Yes	Yes
15	48911	j	No	Yes	Yes	No	No	No	Yes
16	70934	h	No	No	No	Yes	Yes	Yes	No
17	8767	g	No	Yes	Yes	No	No	No	No
18	8961	f	Yes	Yes	Yes	No	Yes	No	No
19	26324	d	Yes	No	Yes	Yes	Yes	Yes	No
20	61679	s	Yes	Yes	No	Yes	No	Yes	Yes
21	29962	a	Yes	Yes	No	No	Yes	No	Yes
22	72390	z	No	Yes	No	Yes	No	No	No
23	22474	x	Yes	No	Yes	Yes	No	Yes	No
24	27881	c	No	Yes	Yes	No	Yes	No	No
25	10897	v	Yes	Yes	Yes	No	Yes	No	Yes
26	63988	b	No	No	Yes	Yes	Yes	Yes	No
27	68620	n	No	No	Yes	Yes	No	Yes	Yes
28	36840	m	No	No	Yes	Yes	Yes	Yes	No
Sheet1

The code is below

Sub MacroToSortOut()
    Dim I As Long, K As Long, LastRow As Long, P As Long, ColStrt As Long
    LastRow = Range("A" & Rows.Count).End(xlUp).Row
    ColStrt = 12
    
    P = 3
    For J = 3 To Cells(1, Columns.Count).End(xlToLeft).Column
        For I = 3 To LastRow
            If Cells(I, J).Value = "Yes" Then
                Cells(P, ColStrt) = Cells(I, 1)
                Cells(P, ColStrt + 1) = Cells(I, 2)
                Cells(P, ColStrt + 2) = Cells(2, J)
                Cells(P, ColStrt + 3) = Cells(1, J)
                P = P + 1
            End If
        Next I
    Next J
End Sub

The Colstrt determines the first column the result is pasted

 

[saurabhlotankar]

Thanks a ton Momentman. The code is working perfect.

Once again thank you so much for ur quick reply.

 

[Momentman]

Thanks a ton Momentman. The code is working perfect.

Once again thank you so much for ur quick reply.

You are welcome. Thanks for the feedback