PDA

View Full Version : [SOLVED] Help to Improve Double Loop Code



DaveGib
03-11-2014, 01:59 AM
Hi All,
I have the code below that works,...... but very s l o w l y!!
Can someone please guide me as to how to improve it?

What I have is a simple user form that the user puts a start date, and an end date.

Using this info I Have entered the start date in column F row 7, I have done a calculation of number of days between dates. using this I have added a day to the initial date in a new column, for the number of days stored. i.e. if the first date is 11/3/2014 and last date is 21/3/2014 I am trying to create a series of dates in the same row that corresponds with the input dates as Column headers. This is done with the first loop.

With the second loop, I am inserting a formula above each date that will give the day of the week for the date i.e. above the date 11/3/2014 will show "Tue"

As I say this is all working but not very efficiently!!

Thanks in advance for taking the time to read this..........
Dave



Private Sub CBOK_Click()
Dim s As Date
Dim e As Date
Dim d As Integer
Dim i As Integer
Dim j As Integer

s = TextBox1.Value ' 1st Date from TextBox1 Input by user

e = TextBox2.Value ' End Date fom textBox2 Input by user
d = Int(e - s) + 6 ' Number of columns to create, starting at Col 6
Range("F7").Select ' put 1st Date as entered by user in Cell F7
Selection.Value = s

For j = 6 To d
For i = 7 To d ' put subsequent dates, to end date in same row
Cells(7, i).Value = Cells(7, i - 1) + 1
Cells(7, i).Select
With Selection ' centre date in cell
.HorizontalAlignment = xlCenter
End With

' Put the day of the week above the dates entered
Cells(6, j).FormulaR1C1 = _
"=CHOOSE(WEEKDAY(R[1]C),""Sun"",""Mon"",""Tue"",""Wed"",""Thu"",""Fri"",""Sat"")"
Cells(6, j).Select
With Selection ' centre day in cell
.HorizontalAlignment = xlCenter
End With
Next i
Next j

Unload Me

End Sub

snb
03-11-2014, 04:28 AM
Sub M_snb()
ReDim sn(1, CDate(Textbox2.Text)-CDate(Textbox1.Text))

For j = 0 To UBound(sn, 2)
sn(0, j) = CDate(Textbox1.Text) + j
sn(1, j) = Format(sn(0, j), "ddd")
Next

with Cells(1, 5).Resize(UBound(sn) + 1, UBound(sn, 2) + 1).Rows(1)
.NumberFormat = "dd-mm-yyyy"
.Value = sn
end with
End Sub

DaveGib
03-12-2014, 02:24 AM
Hi snb,
First off, let me say that I am in Awe of your code..... I have seen your replies to other users, and this is no exception!!
However, - I am a relative novice, and I cannot seem to figure out what I must do..:-(
I have tried just inserting the code in the userform module and clicking in the sub, then Run, which seems to run, but when I step through the code it still goes back through my old code.
I then tried Commenting out all my code, but it wouldn't work at all, I then tried only commenting out the looping section of my code, the first date is put on the sheet in F7, but the rest still didn't work.

I also tried changing changing the following lines of your code as I need the results in rows 6 and 7, thinking that might be the reason - also didn't work..


sn(7, j) = CDate(TextBox1.Text) + j
sn(6, j) = Format(sn(0, j), "ddd")

Is there something that I am perhaps not doing right?

Thanks again for what you have done.........
Dave

snb
03-12-2014, 06:28 AM
1 - you can put my macro in the userform's codemodule
2 - you can refer to my macro using


Private Sub CBOK_Click()
M_snb
End Sub

Instead of the code in the

Private Sub CBOK_Click() event you posted.

or you might use straight away:


Private Sub CBOK_Click()
Redim sn(1, CDate(Textbox2.Text)-CDate(Textbox1.Text))

For j = 0 To UBound(sn, 2)
sn(0, j) = CDate(Textbox1.Text) + j
sn(1, j) = Format(sn(0, j), "ddd")
Next

With Cells(1, 6).Resize(UBound(sn) + 1, UBound(sn, 2) + 1).Rows(1)
.NumberFormat = "dd-mm-yyyy"
.Value = sn
End With
End Sub

I adapted the code so it will be written into rows 6 & 7

DaveGib
03-12-2014, 09:42 AM
Hi snb,
Thanks for the reply!!
I did as you said and now it works - to a point,,,,,,,,,,,,,,,,
From your code above, it was putting the dates in Row 1 column 6 ("F"), so I changed the 1 to 7


With Cells(7, 6).Resize(UBound(sn) + 1, UBound(sn, 2) + 1).Rows(1)

The dates are in row 7 now, but the day does not display, - neither above nor below the date.

When I step through the code, the line below gives the day, but it does not write it to the worksheet.
Regards,
Dave


sn(1, j) = Format(sn(0, j), "ddd")

snb
03-12-2014, 10:02 AM
Private Sub CBOK_Click()
Redim sn(1, CDate(Textbox2.Text)-CDate(Textbox1.Text))

For j = 0 To UBound(sn, 2)
sn(0, j) = CDate(Textbox1.Text) + j
sn(1, j) = Format(sn(0, j), "ddd")
Next

With Cells(6, 1).Resize(UBound(sn) + 1, UBound(sn, 2) + 1)
.Rows(1).NumberFormat = "dd-mm-yyyy"
.Value = sn
End With
End Sub

DaveGib
03-12-2014, 11:27 AM
Hi snb,
a very big THANK YOU!!! - everything is working now!! ..... and at a lightning speed! :bow: :bow:
Regards
Dave

snb
03-12-2014, 11:52 AM
Did you check what each line is performing ?

DaveGib
03-12-2014, 11:31 PM
Hi snb,
I tried to follow what was happening as I stepped thru the code, - and I won't pretend to understand, but I presume that you are loading an array, then reading from that.

snb, you have already helped me so much, and I was afraid to ask before, but would it be possible that you comment each line so that I can learn and understand what you have done?

I also clicked on the "more suggestions...." link and went to what looks like your website, and what I saw looked very impressive, I haven't had time yet to browse it yet, but I certainly will!!

many,..... MANY thanks! - Baie dankie!!
Dave