How to create this new table?

[driverman13]

Sample of raw data: (my data contains A1-A100, 1927-2010)

Date   A1   A2   A3
1927   1     2     3
1928   4     5     6
1929   7     8     9

What i need:

Date        A1     A2    A3
192701    1       2      3
192702    1       2      3
192703    1       2      3
192704    1       2      3
192705    1       2      3    
192706    1       2      3
192707    1       2      3
192708    1       2      3
192709    1       2      3
192710    1       2      3
192711    1       2      3
192712    1       2      3
192801    4       5      6
192802    4       5      6

How would i create this new table that uses the yearly values from raw data and uses it for every month of that year?

Using Win7, Excel 2007

 

[MickG]

Try this:-

[COLOR="Navy"]Sub[/COLOR] MG12Apr21
[COLOR="Navy"]Dim[/COLOR] rng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Rw [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] num [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
num = 0
[COLOR="Navy"]For[/COLOR] n = 1927 To 2010
    num = num + IIf(n = 1927, 0, 3)
    [COLOR="Navy"]For[/COLOR] Rw = 1 To 12
        c = c + 1
        Rw = IIf(Rw < 10, "0" & Rw, Rw)
        [COLOR="Navy"]Set[/COLOR] rng = Cells(c, 1)
        rng = n & Rw
            [COLOR="Navy"]For[/COLOR] Ac = 1 To 3
                rng.Offset(, Ac) = num + Ac
            [COLOR="Navy"]Next[/COLOR] Ac
    [COLOR="Navy"]Next[/COLOR] Rw
[COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[hiker95]

driverman13,


The below macro code will work for all data in column A (only three years were shown). And, it will work for more column titles in row 1.


Sample raw data before the macro:

Excel Workbook
	A	B	C	D	E	F	G	H	I
1	Date	A1	A2	A3
2	1927	1	2	3
3	1928	4	5	6
4	1929	7	8	9
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
Sheet1

After the macro:

Excel Workbook
	A	B	C	D	E	F	G	H	I
1	Date	A1	A2	A3		Date	A1	A2	A3
2	1927	1	2	3		192701	1	2	3
3	1928	4	5	6		192702	1	2	3
4	1929	7	8	9		192703	1	2	3
5						192704	1	2	3
6						192705	1	2	3
7						192706	1	2	3
8						192707	1	2	3
9						192708	1	2	3
10						192709	1	2	3
11						192710	1	2	3
12						192711	1	2	3
13						192712	1	2	3
14						192801	4	5	6
15						192802	4	5	6
16						192803	4	5	6
17						192804	4	5	6
18						192805	4	5	6
19						192806	4	5	6
20						192807	4	5	6
21						192808	4	5	6
22						192809	4	5	6
23						192810	4	5	6
24						192811	4	5	6
25						192812	4	5	6
26						192901	7	8	9
27						192902	7	8	9
28						192903	7	8	9
29						192904	7	8	9
30						192905	7	8	9
31						192906	7	8	9
32						192907	7	8	9
33						192908	7	8	9
34						192909	7	8	9
35						192910	7	8	9
36						192911	7	8	9
37						192912	7	8	9
38
Sheet1

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).


1. Copy the below code, by highlighting the code and pressing the keys CTRL + C
2. Open your workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code by pressing the keys CTRL + V
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel, open the workbook, and press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Option Explicit
Sub CreateNewTable()
' hiker95, 04/12/2011
' http://www.mrexcel.com/forum/showthread.php?t=542890
Dim LR As Long, LC As Long, a As Long, aa As Long, b As Long, rng As Range, NR As Long
Application.ScreenUpdating = False
LR = Cells(Rows.Count, 1).End(xlUp).Row
LC = Cells(1, Columns.Count).End(xlToLeft).Column
Cells(1, LC + 2).Resize(, 4).Value = Cells(1, 1).Resize(, 4).Value
For a = 2 To LR Step 1
  Set rng = Range(Cells(a, 1), Cells(a, LC))
  NR = Cells(Rows.Count, LC + 2).End(xlUp).Row + 1
  Cells(NR, LC + 2).Resize(12, LC).Value = rng.Value
  b = 0
  For aa = NR To NR + 8 Step 1
    b = b + 1
    Cells(aa, LC + 2).Value = Cells(aa, LC + 2).Value & "0" & b
  Next aa
  b = 9
  For aa = NR + 9 To NR + 11 Step 1
    b = b + 1
    Cells(aa, LC + 2).Value = Cells(aa, LC + 2).Value & b
  Next aa
Next a
Application.ScreenUpdating = True
End Sub

Then run the CreateNewTable macro.

 

[driverman13]

Thanks guys, saved me a lot of manual labor.