[RESOLVED] 2 Combo Boxes

Hi
http://www.vbforums.com/images/smilies/wave.gif

Frame A has a Combo Box for Week Nos.
Frame B has a Combo Box for Week Nos.
Both Frames are on the same Form.

Private Sub myWeekNums

If FrameA.Visible = True Then
With cboF_A
AddItem "Wk1"
AddItem "Wk2"
AddItem "Wk3" up to 52
End With
ElseIf FrameB.Visible = True Then
With cboF_B
AddItem "Wk1"
AddItem "Wk2"
AddItem "Wk3" up to 52
End With
End If
End Sub

What I would like to do is have one Combo Box loading to serve both frames.
It is possible for both frames to be visible at the same time.
Can you help please?

Code:

---

Dim I As Integer

For I = 1 To 52
cboF_A AddItem "Wk" & Format(I)
cboF_B AddItem "Wk" & Format(I)
Next I

---

and, yes, both combos can be visible at the same time, in the same or different frames

JG

Hi JG
I must apologize I committed the cardinal sin typing in the code instead of copying which means you did not see the full picture.

This is the code for the combo box
.AddItem "Jan 4th = Wk.1", 1
.AddItem "Jan 11th = Wk.2", 2
.AddItem "Jan 18th = Wk.3", 3

Can there be a solution? or am I stuck with typing 2 full lists?

If I understand, you need a function to return the
Week Number, given a date. Try this code:

Code:

---

Public Function WeekNumber(InDate As Date) As Long
 Dim DayNo As Long
 Dim StartDays As Long
 Dim StopDays As Long
 Dim StartDay As Long
 Dim StopDay As Long
 Dim VNumber As Long
 Dim ThurFlag As Boolean

 DayNo = Days(InDate)
 StartDay = Weekday(DateSerial(Year(InDate), 1, 1)) - 1
 StopDay = Weekday(DateSerial(Year(InDate), 12, 31)) - 1
 ' Number of days belonging to first calendar week
 StartDays = 7 - (StartDay - 1)
 ' Number of days belonging to last calendar week
 StopDays = 7 - (StopDay - 1)
 ' Test to see if the year will have 53 weeks or not
 ThurFlag = (StartDay = 4) Or (StopDay = 4)
 VNumber = (DayNo - StartDays - 4) / 7
 ' If first week has 4 or more days, it will be calendar week 1
 ' If first week has less than 4 days, it will belong to last year's
 ' last calendar week
 If StartDays >= 4 Then
  WeekNumber = Fix(VNumber) + 2
 Else
  WeekNumber = Fix(VNumber) + 1
 End If
 ' Handle years whose last days will belong to coming year's first
 ' calendar week
 If WeekNumber > 52 And ThurFlag = False Then WeekNumber = 1
 ' Handle years whose first days will belong to the last year's
 ' last calendar week
 If WeekNumber = 0 Then
  WeekNumber = WeekNumber(DateSerial(Year(InDate) - 1, 12, 31))
 End If

End Function
Private Function Days(DayNo As Date) As Long
 Days = DayNo - DateSerial(Year(DayNo), 1, 0)
End Function
Function DaysInMonth(YearValue As Long, MonthValue As Long) As Long
 DaysInMonth = Day(DateSerial(YearValue, MonthValue + 1, 0))
End Function
'sample useage
Private Sub Form_Load()
 Dim i As Long
 Dim d As Date
 For i = 1 To 31
  d = DateSerial(2011, 5, i)
  Debug.Print d, WeekNumber(d)
 Next
End Sub

---

Hi VBClasicRocks

That is some stunning code thanks, I will now have to work out how to use it.
It would be a shame not too after I saw the result from the test.

Regards

Code:

---



Private Sub Form_Load()
'To call the procedure that fills the comboboxes
 Dim MyF As Date
    MyF = CDate("04/01/2011")
    FillCombos MyF

End Sub



Sub FillCombos(FirstDayOfWeek As Date)
'Fill comboboxes
 Dim I As Integer

    For I = 1 To 52
        cboF_A.AddItem Format(FirstDayOfWeek, "mmm") & " " & Format(FirstDayOfWeek, "dd") & " Wk." & Format(Week(FirstDayOfWeek), "00")
        cboF_B.AddItem Format(FirstDayOfWeek, "mmm") & " " & Format(FirstDayOfWeek, "dd") & " Wk." & Format(Week(FirstDayOfWeek), "00")
        FirstDayOfWeek = FirstDayOfWeek + 7
    Next I

End Sub


Private Function Week(dteValue As Date) As Integer
'Calculate week number
  'Monday is set as first day of week
  Dim lngDate As Long
  Dim intWeek As Integer
 
  'If january 1. is later than thursday, january 1. is not in week 1
  If Not Weekday("01/01/" & Year(dteValue), vbMonday) > 4 Then
      intWeek = 1
  Else
      intWeek = 0
  End If
 
  'Sets long-value for january 1.
  lngDate = CLng(CDate("01/01/" & Year(dteValue)))
 
  'Finds the first monday of year
  lngDate = lngDate + (8 - Weekday("01/01/" & Year(dteValue), vbMonday))
 
  'Increases week by week until set date is passed
  While Not lngDate > CLng(CDate(dteValue))
      intWeek = intWeek + 1
      lngDate = lngDate + 7
  Wend
 
  'If the date set is not in week 1, this finds latest week previous year
  If intWeek = 0 Then
      intWeek = Week("31/12/" & Year(dteValue) - 1)
  End If
  Week = intWeek
 
End Function

---

JG

Hi JG

Stunning and totally brilliant solves the problem completely, I also hope to learn from the construction you have used.

Many thanks again.

Regards