clearing cells beneath inputted data 1

[westma]

Greetings,
The following code fills in date and times from starttime to stoptime (entered into cells B7 and B8 respectively) in column A. It also enters a direction in column E (in degrees), if an offset direction (entered into cell B6), which is added or subtracted from data in column D, is not zero.

Sub Add_Date()
Const incr = (1 / 144)
stTime = Range("B7").Value
endtime = Range("B8").Value + incr
Offset = Range("B6").Value
newTime = stTime

firstCell = Range("A13").Select
Do While newTime <= endtime
Application.ActiveCell = newTime

If Offset <> 0 Then
ActiveCell.Offset([0], [4]).Select
direction = ActiveCell.Offset([0], [-1]).Value

If direction < 180 Then
Application.ActiveCell = direction + Offset
Else: Application.ActiveCell = direction - Offset

End If
ActiveCell.Offset([0], [-4]).Select

End If
ActiveCell.Offset([1], [0]).Select
newTime = newTime + incr
Loop
End Sub

My question I guess comes in two parts:

First, if a start and stop time are given which contain fewer days than the original and the macro is run, the dates will fill in, but leave the remaining dates from previously showing. Is there any way to program the macro to clear any remaining cells in columns A and E?

Second, the macro takes a considerable amount of time to run with only two months worth of data. I may need to have it run through six months or more worth of times, so can the code be improved to increase speed? I am fairly new with the language and am not sure of syntax which would run more efficiently.

Thanks for your help!

 

[SkipVought]

Hi,

In response to question 1, clear the data first and then write the data.

[A13].CurrentRegion.ClearContents

In response to question 2, do not select cells. This will reduce some of the processing overhead.

faq707-4105 How Can I Make My Code Run Faster?

Sub Add_Date()
   Const incr = (1 / 144)
   stTime = Range("B7").Value
   endtime = Range("B8").Value + incr
   Offset = Range("B6").Value
   newTime = stTime
   lRow = 13
   Cells(lRow, 1).CurrentRegion.ClearContents
   Do While newTime <= endtime
      With Cells(lRow, 1)
         .Value = newTime
       
         If Offset <> 0 Then
            Direction = .Offset(0, 3).Value
            If Direction < 180 Then
               .Offset(0, 4) = Direction + Offset
            Else
               .Offset(0, 4) = Direction - Offset
            End If
         End If
      End With
      lRow = lRow + 1
      newTime = newTime + incr
   Loop
End Sub

Skip,

Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884

 

[westma]

Hey Skip,
Thank you this is much faster. The only problem I have now is that I need data in columns B,C,D to remain, as well as the header in row 12 to remain. To be more precise, I can only clear from row 13 down in columns A and E. Is this possible to do with the line you gave me somehow?
Thanks again!

 

[SkipVought]

Must this data start in ROW 13?

If there is a empty row between the stuff at the top of the sheet and this data, it might be easier.

But here's some code if you do not want to do that...

   lRow = 13
   with Cells(lRow, 1).CurrentRegion
     r1 = .row
     r2 = r1 + .rows.count - 1
     c1 = .column
     c2 = c1 + .columns.count - 1
     range(Cells(lRow, c1), Cells(r2, c2)).ClearContents
   end with

Skip,

Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884

 

[westma]

I could move the header up a row leaving row 12 blank if that is what you mean.

 

[SkipVought]

sure!

Skip,

Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884

 

[westma]

Skip, are you still there?

 

[westma]

Nevermind, I figured out my problem. Thanks again for all your help!