Not sure what code to use.

Jacko1996 · Jun 2, 2015

Hey so I have a whole bunch of daily data for a weather station. What I want it to do is create a table made of monthly data for all the years using the daily data. I'm not sure what formula to use.

The table below shows kind what it looks like, however on a much larger scale

Year	Month	Day	Rainfall amount (millimetres)
1893	12	1	0
1893	12	2	0
1893	12	3	0
1893	12	4	0
1893	12	5	0
1893	12	6	0
1893	12	7	0
1893	12	8	0
1893	12	9	0
1893	12	10	0
1893	12	11	0
1893	12	12	0
1893	12	13	0
1893	12	14	0
1893	12	15	0
1893	12	16	0
1893	12	17	0
1893	12	18	2
1893	12	19	0
1893	12	20	0
1893	12	21	0
1893	12	22	0
1893	12	23	0
1893	12	24	0
1893	12	25	0
1893	12	26	0
1893	12	27	0
1893	12	28	0
1893	12	29	0
1893	12	30	0
1893	12	31	0
1894	1	1	7.9
1894	1	2	0
1894	1	3	0
1894	1	4	0
1894	1	5	0
1894	1	6	2.3
1894	1	7	0
1894	1	8	0
1894	1	9	64.5
1894	1	10	12.7
1894	1	11	0
1894	1	12	0
1894	1	13	31.8
1894	1	14	29.7
1894	1	15	38.4
1894	1	16	8.1
1894	1	17	0
1894	1	18	0
1894	1	19	9.7
1894	1	20	0
1894	1	21	0
1894	1	22	99.1
1894	1	23	0
1894	1	24	16.5
1894	1	25	14.7
1894	1	26	0.3
1894	1	27	4.8
1894	1	28	4.8
1894	1	29	56.4

Below is what i want it to look like the values are made up but those would be the values of rainfall for the months.

Year	Jan	Feb	Mar	Apr	May	June	July	Aug	Sep	Nov	Oct	Dec
1983	0	0	0	0	0	0	4	6	2	0	120	80
1984	230	43	668	26	1300	34	2	3	4	6	7	9

Danerida · Jun 2, 2015

If your daily data in columns A:D on sheet 1 and your summary table starts in Cell A1 on Sheet 2:

Code:

Cell B2 =SUMIFS('Sheet1'$D:$D,'Sheet1'$A:$A,'Sheet2'$A2,'Sheet1'$B:$B,COLUMN()-1)

This formula can be copied across and down as needed.

Dan

hiker95 · Jun 2, 2015

Jacko1996,

1. What version of Excel, and, Windows are you using?

2. Are you using a PC or a Mac?

Here is a macro solution for you to consider, based on your posted data, with your raw data sorted/grouped by column A, Year, and, column B, Month.

You can change the raw data worksheet name in the macro.

Sample raw data:

Excel 2007

A

B

C

D

1

Year

Month

Day

Rainfall amount (millimetres)

2

1893

12

1

0

3

1893

12

2

0

4

1893

12

3

0

5

1893

12

4

0

6

1893

12

5

0

7

1893

12

6

0

8

1893

12

7

0

9

1893

12

8

0

10

1893

12

9

0

11

1893

12

10

0

12

1893

12

11

0

13

1893

12

0

14

1893

12

13

0

15

1893

12

14

0

16

1893

12

15

0

17

1893

12

16

0

18

1893

12

17

0

19

1893

12

18

2

20

1893

12

19

0

21

1893

12

20

0

22

1893

12

21

0

23

1893

12

22

0

24

1893

12

23

0

25

1893

12

24

0

26

1893

12

25

0

27

1893

12

26

0

28

1893

12

27

0

29

1893

12

28

0

30

1893

12

29

0

31

1893

12

30

0

32

1893

12

31

0

33

1894

1

7.9

34

1894

1

2

0

35

1894

1

3

0

36

1894

1

4

0

37

1894

1

5

0

38

1894

1

6

2.3

39

1894

1

7

0

40

1894

1

8

0

41

1894

1

9

64.5

42

1894

1

10

12.7

43

1894

1

11

0

44

1894

1

12

0

45

1894

1

13

31.8

46

1894

1

14

29.7

47

1894

1

15

38.4

48

1894

1

16

8.1

49

1894

1

17

0

50

1894

1

18

0

51

1894

1

19

9.7

52

1894

1

20

0

53

1894

1

21

0

54

1894

1

22

99.1

55

1894

1

23

0

56

1894

1

24

16.5

57

1894

1

25

14.7

58

1894

1

26

0.3

59

1894

1

27

4.8

60

1894

1

28

4.8

61

1894

1

29

56.4

62

Sheet1

After the macro in a new worksheet Rainfall:

Excel 2007

A

B

C

D

E

F

G

H

I

J

K

L

M

1

Year

Jan

Feb

Mar

Apr

May

June

July

Aug

Sep

Oct

Nov

Dec

2

1893

0

2

3

1894

401.7

0

4

Rainfall

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 macro code, and, function
2. Open your NEW 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
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Code:

Sub YearMonthRainfall()
' hiker95, 06/02/2015, ME858813
Dim w1 As Worksheet, wr As Worksheet
Dim o As Variant, j As Long, rng As Range, nlr As Long
Dim lr As Long, nrl As Long, r As Long, c As Long, n As Long, m As Long, msum As Double
Application.ScreenUpdating = False
Set w1 = Sheets("Sheet1")   '<-- you can change the sheet name here
With w1
  lr = .Cells(Rows.Count, 1).End(xlUp).Row
  With .Range("E2:E" & lr)
    .Formula = "=A2&B2"
    .Value = .Value
  End With
  Set rng = .Range("E2:E" & lr)
  nlr = CountUnique(rng)
  ReDim o(1 To nlr + 1, 1 To 13)
  j = j + 1: o(j, 1) = "Year"
  o(j, 2) = "Jan": o(j, 3) = "Feb": o(j, 4) = "Mar": o(j, 5) = "Apr"
  o(j, 6) = "May": o(j, 7) = "June": o(j, 8) = "July": o(j, 9) = "Aug"
  o(j, 10) = "Sep": o(j, 11) = "Oct": o(j, 12) = "Nov": o(j, 13) = "Dec"
  For r = 2 To lr
    n = Application.CountIf(.Columns(5), .Cells(r, 5).Value)
    j = j + 1: o(j, 1) = .Cells(r, 1).Value
    For c = 2 To UBound(o, 2)
      o(j, c) = 0
    Next c
    m = .Cells(r, 2) + 1
    msum = Evaluate("=Sum(D" & r & ":D" & r + n - 1 & ")")
    o(j, m) = msum
    r = r + n - 1
  Next r
  rng.ClearContents
End With
If Not Evaluate("ISREF(Rainfall!A1)") Then Worksheets.Add(After:=w1).Name = "Rainfall"
Set wr = Worksheets("Rainfall")
With wr
  .UsedRange.Clear
  .Cells(1, 1).Resize(UBound(o, 1), UBound(o, 2)) = o
  .Columns("A:M").AutoFit
  .Activate
End With
End Sub
Function CountUnique(ByVal rng As Range) As Long
' Juan Pablo González, MrExcel MVP, 05/09/2003
' http://www.mrexcel.com/forum/excel-questions/48385-need-count-unique-items-column-visual-basic-applications.html
Dim St As String
Set rng = Intersect(rng, rng.Parent.UsedRange)
St = "'" & rng.Parent.Name & "'!" & rng.Address(False, False)
CountUnique = Evaluate("SUM(IF(LEN(" & St & "),1/COUNTIF(" & St & "," & St & ")))")
End Function

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm, and, answer the "do you want to enable macros" question as "yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.

Then run the YearMonthRainfall macro.

Rick Rothstein · Jun 2, 2015

Here is another macro that you can consider...

Code:

Sub YearMonthRainfallToo()
  Dim r As Long, LastRow As Long, Data As Variant, Result As Variant
  LastRow = Sheets("[B][COLOR="#0000FF"]Sheet1[/COLOR][/B]").Cells(Rows.Count, "A").End(xlUp).Row
  Data = Sheets("[B][COLOR="#0000FF"]Sheet1[/COLOR][/B]").Range("A2:D" & LastRow)
  ReDim Result(Data(1, 1) To Data(UBound(Data), 1), 0 To 12)
  For r = 1 To UBound(Data) - LBound(Data) + 1
    If Result(Data(r, 1), 0) = "" Then Result(Data(r, 1), 0) = Data(r, 1)
    Result(Data(r, 1), Data(r, 2)) = Result(Data(r, 1), Data(r, 2)) + Data(r, 4)
  Next
  With Sheets("[B][COLOR="#0000FF"]Rainfall[/COLOR][/B]")
    .Cells.Clear
    .Range("A1:M1") = Array("Year", "Jan", "Feb", "Mar", "Apr", "May", _
                      "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")
    .Range("A2").Resize(UBound(Result) - LBound(Result) + 1, 13) = Result
    On Error Resume Next
    .Range("A2").Resize(UBound(Result) - LBound(Result) + 1, 13).SpecialCells(xlBlanks) = 0
    On Error GoTo 0
  End With
End Sub

Andrew Fergus · Jun 3, 2015

What about a pivot table? This is precisely the sort of thing pivot tables were designed for. Months as column headers, years as the row headers, the rainfall is the value - sum / average / whatever you want. So long as your data is clean and contiguous it shouldn't be a problem.

hiker95 · Jun 3, 2015

Jacko1996,

Here is another macro solution for you to consider, based on your posted data, with your raw data sorted/grouped by column A, Year, and, column B, Month.

You can change the raw data worksheet name in the macro.

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 macro code, and, function
2. Open your NEW 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
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Code:

Sub YearMonthRainfall_V2()
' hiker95, 06/03/2015, ME858813
Dim w1 As Worksheet, wr As Worksheet
Dim o As Variant, j As Long, rng As Range, nlr As Long
Dim lr As Long, nrl As Long, r As Long, n As Long, m As Long, msum As Double
Application.ScreenUpdating = False
Set w1 = Sheets("Sheet1")   '<-- you can change the sheet name here
With w1
  .Activate
  lr = .Cells(Rows.Count, 1).End(xlUp).Row
  With .Range("E2:E" & lr): .Formula = "=A2&B2": .Value = .Value: End With
  Set rng = .Range("E2:E" & lr)
  nlr = CountUnique_V2(rng)
  ReDim o(1 To nlr, 1 To 13)
  For r = 2 To lr
    n = Application.CountIf(.Columns(5), .Cells(r, 5).Value)
    j = j + 1: o(j, 1) = .Cells(r, 1).Value: m = .Cells(r, 2) + 1
    msum = Evaluate("=Sum(D" & r & ":D" & r + n - 1 & ")"): o(j, m) = msum
    r = r + n - 1
  Next r
  rng.ClearContents
End With
If Not Evaluate("ISREF(Rainfall!A1)") Then Worksheets.Add(After:=w1).Name = "Rainfall"
Set wr = Sheets("Rainfall")
With wr
  .UsedRange.Clear
  .Cells(1, 1).Resize(, 13).Value = Array("Year", "Jan", "Feb", "Mar", "Apr", "May", _
                                  "June", "July", "Aug", "Sep", "Oct", "Nov", "Dec")
  .Cells(2, 1).Resize(UBound(o, 1), UBound(o, 2)) = o
  On Error Resume Next
  .Range("B2").Resize(UBound(o, 1), UBound(o, 2)).SpecialCells(xlBlanks) = 0
  On Error GoTo 0
  .Columns("A:M").AutoFit
  .Activate
End With
End Sub
Function CountUnique_V2(ByVal rng As Range) As Long
' Juan Pablo González, MrExcel MVP, 05/09/2003
' http://www.mrexcel.com/forum/excel-questions/48385-need-count-unique-items-column-visual-basic-applications.html
Dim St As String
Set rng = Intersect(rng, rng.Parent.UsedRange)
St = "'" & rng.Parent.Name & "'!" & rng.Address(False, False)
CountUnique_V2 = Evaluate("SUM(IF(LEN(" & St & "),1/COUNTIF(" & St & "," & St & ")))")
End Function

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm, and, answer the "do you want to enable macros" question as "yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.

Then run the YearMonthRainfall_V2 macro.

Rick Rothstein · Jun 3, 2015

Rick Rothstein said:

Here is another macro that you can consider...

Code:

Sub YearMonthRainfallToo()
  Dim r As Long, LastRow As Long, Data As Variant, Result As Variant
  LastRow = Sheets("[B][COLOR="#0000FF"]Sheet1[/COLOR][/B]").Cells(Rows.Count, "A").End(xlUp).Row
  Data = Sheets("[B][COLOR="#0000FF"]Sheet1[/COLOR][/B]").Range("A2:D" & LastRow)
  ReDim Result(Data(1, 1) To Data(UBound(Data), 1), 0 To 12)
  For r = 1 To UBound(Data) - LBound(Data) + 1
    If Result(Data(r, 1), 0) = "" Then Result(Data(r, 1), 0) = Data(r, 1)
    Result(Data(r, 1), Data(r, 2)) = Result(Data(r, 1), Data(r, 2)) + Data(r, 4)
  Next
  With Sheets("[B][COLOR="#0000FF"]Rainfall[/COLOR][/B]")
    .Cells.Clear
    .Range("A1:M1") = Array("Year", "Jan", "Feb", "Mar", "Apr", "May", _
                      "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")
    .Range("A2").Resize(UBound(Result) - LBound(Result) + 1, 13) = Result
    On Error Resume Next
    .Range("A2").Resize(UBound(Result) - LBound(Result) + 1, 13).SpecialCells(xlBlanks) = 0
    On Error GoTo 0
  End With
End Sub

I forgot to mention that the above code (which I posted earlier), as written, requires that your data be sorted by the Year column (sorting by the other columns is not required for it to work). That seemed like a logical assumption to make; however, if your data is not sorted that way (let's say additional data for an earlier year came in from another source and you just stuck it at the bottom of the list), then a small change to one line of code will make my macro work with non-sorted data...

Code:

Sub YearMonthRainfallToo()
  Dim R As Long, LastRow As Long, Data As Variant, Result As Variant
  LastRow = Sheets("[COLOR="#0000FF"][B]Sheet1[/B][/COLOR]").Cells(Rows.Count, "A").End(xlUp).Row
  Data = Sheets("[COLOR="#0000FF"][B]Sheet1[/B][/COLOR]").Range("A2:D" & LastRow)
  ReDim Result(Application.Min(Sheets("[COLOR="#0000FF"][B]Sheet1[/B][/COLOR]").Columns("A")) To _
        Application.Max(Sheets("[COLOR="#0000FF"][B]Sheet1[/B][/COLOR]").Columns("A")), 0 To 12)
  For R = 1 To UBound(Data) - LBound(Data) + 1
    If Result(Data(R, 1), 0) = "" Then Result(Data(R, 1), 0) = Data(R, 1)
    Result(Data(R, 1), Data(R, 2)) = Result(Data(R, 1), Data(R, 2)) + Data(R, 4)
  Next
  With Sheets("[COLOR="#0000FF"][B]Rainfall[/B][/COLOR]")
    .Cells.Clear
    .Range("A1:M1") = Array("Year", "Jan", "Feb", "Mar", "Apr", "May", _
                      "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")
    .Range("A2").Resize(UBound(Result) - LBound(Result) + 1, 13) = Result
    On Error Resume Next
    .Range("A2").Resize(UBound(Result) - LBound(Result) + 1, 13).SpecialCells(xlBlanks) = 0
    On Error GoTo 0
  End With
End Sub

In addition, this code, and the code I posted earlier, also requires that every year be represented with at least one value. That also seemed like a logical assumption to make; however, it that is not the case and some years have no data, then you will need to use this modification to the above code instead...

Code:

Sub YearMonthRainfallToo()
  Dim R As Long, LastRow As Long, Data As Variant, Result As Variant
  LastRow = Sheets("[COLOR="#0000FF"][B]Sheet1[/B][/COLOR]").Cells(Rows.Count, "A").End(xlUp).Row
  Data = Sheets("[COLOR="#0000FF"][B]Sheet1[/B][/COLOR]").Range("A2:D" & LastRow)
  ReDim Result(Application.Min(Sheets("[B][COLOR="#0000FF"]Sheet1[/COLOR][/B]").Columns("A")) To _
        Application.Max(Sheets("[COLOR="#0000FF"][B]Sheet1[/B][/COLOR]").Columns("A")), 0 To 12)
  For R = 1 To UBound(Data) - LBound(Data) + 1
    If Result(Data(R, 1), 0) = "" Then Result(Data(R, 1), 0) = Data(R, 1)
    Result(Data(R, 1), Data(R, 2)) = Result(Data(R, 1), Data(R, 2)) + Data(R, 4)
  Next
  With Sheets("[B][COLOR="#0000FF"]Rainfall[/COLOR][/B]")
    .Cells.Clear
    .Range("A1:M1") = Array("Year", "Jan", "Feb", "Mar", "Apr", "May", _
                      "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")
    .Range("A2").Resize(UBound(Result) - LBound(Result) + 1, 13) = Result
    On Error Resume Next
    With .Range("B2").Resize(UBound(Result) - LBound(Result) + 1)
      .Resize(, 13).SpecialCells(xlBlanks) = 0
      .Offset(, -1).SpecialCells(xlBlanks).EntireRow.Delete
    End With
    On Error GoTo 0
  End With
End Sub

Jacko1996 · Jun 3, 2015

So i used your macro and it worked, thanks so much, but i have formulas on the same page, but whenever i bring it in it deletes it.


Monthly Data	Jan	Feb	Mar	Apr	May	June	July	Aug	Sep	Oct	Nov	Dec
0-100	683	17	21	29	45	57	80	87	93	88	69	56	41
101-200	401	50	44	28	45	38	19	19	17	21	35	44	41
201-300	150	25	19	21	16	13	13	6	0	1	7	8	21
301-400	72	10	14	18	4	5	1	1	0	0	5	6	8
401-500	31	3	5	11	3	1	1	1	1	0	0	2	3
501-600	25	6	4	7	4	1	2	0	0	0	0	0	1
601-700	8	1	3	0	0	1	0	0	0	0	0	0	3
701-800	6	2	2	2	0	0	0	0	0	0	0	0	0
801-900	6	1	3	1	0	0	0	1	0	0	0	0	0
901-1000	1	0	1	0	0	0	0	0	0	0	0	0	0
1001-1100	1	0	1	0	0	0	0	0	0	0	0	0	0
1101-1200	0	0	0	0	0	0	0	0	0	0	0	0	0
1201-1300	3	2	0	1	0	0	0	0	0	0	0	0	0
1301-1400	0	0	0	0	0	0	0	0	0	0	0	0	0

It deletes this when i bring it in. How do i stop it doing that.

Jacko1996 · Jun 4, 2015

Dim r As Long, LastRow As Long, Data As Variant, Result As Variant
LastRow = Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
Data = Sheets("Sheet1").Range("A2:D" & LastRow)
ReDim Result(Data(1, 1) To Data(UBound(Data), 1), 0 To 12)
For r = 1 To UBound(Data) - LBound(Data) + 1

If Result(Data(r, 1), 0) = "" Then Result(Data(r, 1), 0) = Data(r, 1)
Result(Data(r, 1), Data(r, 2)) = Result(Data(r, 1), Data(r, 2)) + Data(r, 4)
Next
With Sheets("Rainfall")
.Cells.Clear
.Range("A1:M1") = Array("Year", "Jan", "Feb", "Mar", "Apr", "May", _
"Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")
.Range("A2").Resize(UBound(Result) - LBound(Result) + 1, 13) = Result
On Error Resume Next
.Range("A2").Resize(UBound(Result) - LBound(Result) + 1, 13).SpecialCells(xlBlanks) = 0
On Error GoTo 0
End With
End Sub

Are you able to tell me what the stuff highlighted in red mean. I want to comment and write this data myself, but i want to know what it means.

Thankyou

hiker95 · Jun 4, 2015

Jacko1996,

When you respond to your helper(s), please use their site ID/username/handle.

This will keep thread clutter to a minimum, and, make the discussion easier to follow.

Have you even tried either of my two macro solutions?

Not sure what code to use.

Jacko1996

New Member

Excel Facts

Danerida

Board Regular

hiker95

Well-known Member

Rick Rothstein

MrExcel MVP

Andrew Fergus

MrExcel MVP

hiker95

Well-known Member

Rick Rothstein

MrExcel MVP

Jacko1996

New Member

Jacko1996

New Member

hiker95

Well-known Member

Similar threads

Forum statistics

Share this page

Not sure what code to use.

New Member

Excel Facts

Board Regular

Well-known Member

MrExcel MVP

MrExcel MVP

Well-known Member

MrExcel MVP

New Member

New Member

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock