Hi again,
as I see it there are two main issues.

a) To make your macro work for 28-31 days
b) to add the extra rows for the hours "inbetween".

Regarding (a), it is not always easy to adjust an already recorded macro (much easier if it was "programmed"). One way of solving this is the following:
1) Re-record your macro for a month with 31 days (for example July).
2) Save this as your "permanent macro", that you in the future use for every month.
3) Run this macro for a short month (February, April, June etc). Please publish the result of this macro run (= how your excel sheet "my macro" looks like for april) here, so I can have a look at it. Then I can see if I can create an additional macro, that simply deletes the extra rows.

Regarding (b) I am looking at it, but I am quite busy the next 2-3 days.

Kind regards
Bjorn

Hi, I will do the macro again and post it ASAP. Thank you )

Hi,
try this!

Activate the sheet "My Macros" and then run the macro below. This should turn this sheet into same appearance as the sheet "Final".

Kind regards
Bjorn


Sub FixRows()
Application.ScreenUpdating = False
Dim rownum As Long
Dim rowhour As Long
rownum = 4
rowhour = 0
Do Until Cells(rownum, 4).Value = "" And rowhour = 0
If Cells(rownum, 4).Value <> rowhour And Cells(rownum, 4).Value Mod 100 = 0 Then

Cells(rownum, 1).EntireRow.Insert
Cells(rownum - 1, 1).Range("A1:L1").Copy _
Destination:=Cells(rownum, 1)
Cells(rownum, 4).Value = rowhour
If rowhour Mod 300 = 0 Then
With Cells(rownum, 5)
.NumberFormat = "0"
.FormulaR1C1 = "9999"
.Interior.ColorIndex = 6
.Interior.Pattern = xlSolid
.Borders.LineStyle = xlcontinous
.Borders.Weight = xlThin
.Borders.ColorIndex = xlAutomatic
End With
Cells(rownum, 5).Copy Destination:=Cells(rownum, 1).Range("E1:L1")
End If

End If

rownum = rownum + 1
rowhour = rowhour + 100
If rowhour = 2400 Then rowhour = 0
Loop
Application.ScreenUpdating = False
End Sub

WOW!! It worked!!! Thank you very much, I will try on a full data, I will try it for a year and I will let you know about the results, and tomorrow I will attach the re-recorded macro. Again, thank you very much BjornS ) you saved me )

Hi Bjorn,
Your macro worked PERFECTLY!! Thank you very much. Regarding deleting extra rows, you will see an XLS file attached that includes the macro working for July 2006 (and I recorded the macro according to it) and June 2005. There will be 4 sheets, the first and the third sheets ("07_2006_BF" and (06_2005_BF") are the data before the macro while the second and the fourth sheets ("07_2006_AF" and "06_2005_AF") are the data after applying the macro. Also you will see a TXT file attached that includes the macro I recorded. Will you gonna edit the macros so they will stop working when they face an empty cell or you will make a new macro to delete the extra rows? And another thing, when I apply "macro2" a message appears to confirm pasting the cells over the existing cells and I should hit OK, how can I edit the macro so it will hit OK instead of me?
Many thanks Bjorn for your GREAT effort with me, you really saved a lot of my time.

Attached Files

	Weather_Forum.xls (261.5 KB, 19 views)
	macro_Forum.txt (11.3 KB, 14 views)

Hi,
try this around your macros:

Sub macro xx()
Application.DisplayAlerts = False
(please your existing code here)
Application.DisplayAlerts=True
End sub


You can also place these commands just around the part of the code that creates these kind of messages (how to find them? => Press Alt-F11 to see your macro, place cursor at macro beginning, run the macro "step by step" by pressing F8 over and over again, until you see what code creates this message).

Kind regards
Bjorn

I am very sorry!! It was "Macro2" that make the msg. I will try your solution now. Thanks )

Hi again,
after you have run your recorded macro's try this macro (still before the macro I wrote for you). It will delete rows where there is data in column "E" but no data in column "D".

I think we are through now with all issues!!

Kind regards
Bjorn

PS. Have a look at the code. As you see it is not so complicated with some simple macro's, why not try to learn? It started learning just some few months ago, just by googling around

Sub FixShortMonth()
Application.ScreenUpdating = False

Dim rownum As Long
rownum = 174

Do Until Cells(rownum, 5).Value = ""

If Cells(rownum, 4).Value = "" Then
Cells(rownum, 1).EntireRow.Delete
Else
rownum = rownum + 1
End If

Loop

Application.ScreenUpdating = False
End Sub

Hey Bjorn!
Man you really helped me! The fixmonth macro worked perfectly, and the code to fix the confirmation msg also worked ) I will learn about visual basic and macros, actually I learned a lot from you, but I am now racing the time, so what I do is observing what you do and then I will create something, I will deal later with weather data again but I will have time to learn and fix the issue ) Any ways, one last thing, when I applied your macro the "FixRows" macro it copied and pasted the header for the first 5 hours instead of just copying the data!! The result is attached in the sheet "06_2005_fixrow", I highlighted the error in red. If we you fixed this issue for me now I will finish the around 300 files by Sunday

Attached Files

Weather_Forum.xls (354.0 KB, 17 views)

Hi,
try this instead!

Good night (at least in my part of the world :-)

Kind regards
Bjorn


Sub FixRows()
Application.ScreenUpdating = False
Dim rownum As Long
Dim rowhour As Long
Dim CopyOffset As Long
rownum = 4
rowhour = 0
Do Until Cells(rownum, 4).Value = "" And rowhour = 0
If Cells(rownum, 4).Value <> rowhour And Cells(rownum, 4).Value Mod 100 = 0 Then
Cells(rownum, 1).EntireRow.Insert
If rownum = 4 Then CopyOffset = 1 Else CopyOffset = -1
Cells(rownum + CopyOffset, 1).Range("A1:L1").Copy _
Destination:=Cells(rownum, 1)
Cells(rownum, 4).Value = rowhour
If rowhour Mod 300 = 0 Then
With Cells(rownum, 5)
.NumberFormat = "0"
.FormulaR1C1 = "9999"
.Interior.ColorIndex = 6
.Interior.Pattern = xlSolid
.Borders.LineStyle = xlcontinous
.Borders.Weight = xlThin
.Borders.ColorIndex = xlAutomatic
End With
Cells(rownum, 5).Copy Destination:=Cells(rownum, 1).Range("E1:L1")
End If
End If
rownum = rownum + 1
rowhour = rowhour + 100
If rowhour = 2400 Then rowhour = 0
Loop
Application.ScreenUpdating = False
End Sub

Thank you Bjorn, you fixed my problems COMPLETELY and I am very honored to contact with you, I wish we will still in contact I am very pleased to have a friend like you, I will send you my contact on a private message. It is also bed time in my world I live in Jordan, and it is now 12.33Am. Again, I highly appreciate your patience with me Best of luck my friend, and God bless you.
Tareq.