• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 230
  • Last Modified:

help modify to run faster

Hi,

Kindly help me modify the code below to make it run faster.
Please write the full part of the code you're going to edit.

Thanks,
Lynnton


database is ms access
binary1 table=7 columns (from monday to sunday) 96 columns (from 00:00 to 23:45 fifteen minute interval)
forcastsched==7 columns (from monday to sunday) 96 columns (from 00:00 to 23:45 fifteen minute interval)
required table=7 column (from monday to sunday) 48 records (one record everyhalf hour 00:00 to 23:30)

Private Sub Command1_Click()
    MousePointer = vbHourglass
    Set RSforecast = New ADODB.Recordset
    RSforecast.CursorLocation = adUseClient

   'get the highest required
    SQL = "SELECT  top 1 dayname FROM " & _
    "( " & _
    "SELECT 'Monday' as DayName, SUM(Monday) As DaySum FROM required " & _
    "Union All " & _
    "SELECT 'Tuesday', SUM(Tuesday) FROM required " & _
    "Union All " & _
    "SELECT 'Wednesday', SUM(Wednesday) FROM required " & _
    "Union All " & _
    "SELECT 'Thursday', SUM(Thursday) FROM required " & _
    "Union All " & _
    "SELECT 'Friday', SUM(Friday) FROM required " & _
    "Union All " & _
    "SELECT 'Saturday', SUM(Saturday) FROM required " & _
    "Union All " & _
    "SELECT 'Sunday', SUM(Sunday) FROM required " & _
    " As B) ORDER BY Daysum desc"
    RSforecast.Open SQL, cnForecast, adOpenKeyset, adLockReadOnly
    StartDay = RSforecast(0).Value
    RSforecast.Close

    '--------------------------------REQURED SCHEDULES
    'get the lowest number of required
    SQL = "SELECT requiredid from required " & _
    "where " & StartDay & " = (select min(" & StartDay & ") from required)"
    RSforecast.Open SQL, cnForecast, adOpenKeyset, adLockReadOnly
    RequiredID = RSforecast(0).Value
    RSforecast.Close

    '-------------loop thought all the records
    LeftOverDay = ConvertDay(StartDay)
    LeftOverTime = RequiredID
    EndReq = 48
    EndDay = 7
    GenSchedules
End Sub
____________________________________________________________________________________________
Public Sub GenSchedules()

For R = ConvertDay(StartDay) To EndDay
    For Q = RequiredID To EndReq
        For M = 1 To 2
            If M = 2 Then
                If Right(StartTime, 2) = "00" Then
                    StartTime = Left(StartTime, 2) & "15"
                Else
                    StartTime = Left(StartTime, 2) & "45"
                End If
            End If

    '-------------------------------REQUIRED------
                If M = 1 Then
    SQL = "SELECT time," & StartDay & ",requiredid,monday,tuesday,wednesday,thursday,friday,saturday,sunday " & _
    "from required where requiredid = " & Q & ""
    RSforecast.Open SQL, cnForecast, adOpenKeyset, adLockReadOnly
            StartTime = RSforecast(0).Value
            Needed = RSforecast(1).Value
            RequiredIDD = RSforecast(2).Value
            ReqMon = RSforecast(3).Value
            ReqTue = RSforecast(4).Value
            ReqWed = RSforecast(5).Value
            ReqThu = RSforecast(6).Value
            ReqFri = RSforecast(7).Value
            ReqSat = RSforecast(8).Value
            ReqSun = RSforecast(9).Value
    RSforecast.Close
                End If

    '-------------------------------FORECAST SCHEDULES
    'get all the yes value on days and how many operators are presently seated
    ' GET RECORD WITH CROSSOVER
                If Q < 18 Then
      SQL = "SELECT  DISTINCT " & _
    "(SELECT sum([" & StartTime & "]) as days  FROM forecastsched WHERE (monday = 'Y' and crossover is null) " & _
    "or (sunday = 'Y' and crossover = 'Y')) as Monday, " & _
    "(SELECT sum([" & StartTime & "]) FROM forecastsched WHERE (tuesday = 'Y' and crossover is null) " & _
    "or (monday = 'Y' and crossover = 'Y')) as Tuesday, " & _
    "(SELECT sum([" & StartTime & "]) FROM forecastsched WHERE (wednesday = 'Y'  and crossover is null) " & _
    "or (tuesday = 'Y' and crossover = 'Y')) as Wednesday, " & _
    "(SELECT sum([" & StartTime & "]) FROM forecastsched WHERE (thursday = 'Y'  and crossover is null) " & _
    "or (wednesday = 'Y' and crossover = 'Y')) as Thursday, " & _
    "(SELECT sum([" & StartTime & "]) FROM forecastsched WHERE (friday = 'Y'  and crossover is null) " & _
    "or (thursday = 'Y' and crossover = 'Y')) as Friday, " & _
    "(SELECT sum([" & StartTime & "]) FROM forecastsched WHERE (saturday = 'Y'  and crossover is null) " & _
    "or (friday = 'Y' and crossover = 'Y')) as Saturday, " & _
    "(SELECT sum([" & StartTime & "]) FROM forecastsched WHERE (sunday = 'Y'  and crossover is null) " & _
    "or (saturday = 'Y' and crossover = 'Y')) as Sunday from forecastsched "
                Else
    SQL = "SELECT  DISTINCT " & _
    "(SELECT sum([" & StartTime & "]) as days  FROM forecastsched WHERE monday = 'y') as Monday, " & _
    "(SELECT sum([" & StartTime & "]) FROM forecastsched WHERE tuesday = 'y') as Tuesday, " & _
    "(SELECT sum([" & StartTime & "]) FROM forecastsched WHERE wednesday = 'y') as Wednesday, " & _
    "(SELECT sum([" & StartTime & "]) FROM forecastsched WHERE thursday = 'y') as Thursday, " & _
    "(SELECT sum([" & StartTime & "]) FROM forecastsched WHERE friday = 'y') as Friday, " & _
    "(SELECT sum([" & StartTime & "]) FROM forecastsched WHERE saturday = 'y') as Saturday, " & _
    "(SELECT sum([" & StartTime & "]) FROM forecastsched WHERE sunday = 'y') as Sunday from forecastsched"
                End If
    RSforecast.Open SQL, cnForecast, adOpenKeyset, adLockReadOnly
            If RSforecast.EOF And RSforecast.BOF Then
                Actual = 0
                ForMon = 0
                ForTue = 0
                ForWed = 0
                ForThu = 0
                ForFri = 0
                ForSat = 0
                ForSun = 0
            Else
                Actual = IIf(IsNull(RSforecast(StartDay).Value), 0, RSforecast(StartDay).Value)
                ForMon = IIf(IsNull(RSforecast(0).Value), 0, RSforecast(0).Value)
                ForTue = IIf(IsNull(RSforecast(1).Value), 0, RSforecast(1).Value)
                ForWed = IIf(IsNull(RSforecast(2).Value), 0, RSforecast(2).Value)
                ForThu = IIf(IsNull(RSforecast(3).Value), 0, RSforecast(3).Value)
                ForFri = IIf(IsNull(RSforecast(4).Value), 0, RSforecast(4).Value)
                ForSat = IIf(IsNull(RSforecast(5).Value), 0, RSforecast(5).Value)
                ForSun = IIf(IsNull(RSforecast(6).Value), 0, RSforecast(6).Value)
            End If
    RSforecast.Close

            If Needed > Actual Then
            'need to get different schedules, odd number and record what was the last schedule given then follow on
           
    '-------------------------------REQUIRED FORCAST TREND
                If Q = 48 Then
                    SQL = "SELECT " & WeekdayName(IIf(ConvertDay(StartDay) = 6, -1, ConvertDay(StartDay)) Mod 7 + 2) & "" & _
                        " from required where requiredid = 1"
                Else
                    SQL = "SELECT " & StartDay & " from required where requiredid = " & Q + 1 & ""
                End If
            RSforecast.Open SQL, cnForecast, adOpenKeyset, adLockReadOnly
            ForReq = RSforecast(0).Value
            RSforecast.Close
            'PercentDiff = ((ForReq / Needed) * 100) - 100
            W = 0

            If ForReq < Needed Then W = W + 20

            ForMon = IIf((ReqMon - ForMon) > 0, ReqMon - ForMon, 0)
            ForTue = IIf((ReqTue - ForTue) > 0, ReqTue - ForTue, 0)
            ForWed = IIf((ReqWed - ForWed) > 0, ReqWed - ForWed, 0)
            ForThu = IIf((ReqThu - ForThu) > 0, ReqThu - ForThu, 0)
            ForFri = IIf((ReqFri - ForFri) > 0, ReqFri - ForFri, 0)
            ForSat = IIf((ReqSat - ForSat) > 0, ReqSat - ForSat, 0)
            ForSun = IIf((ReqSun - ForSun) > 0, ReqSun - ForSun, 0)

                Do While (ForMon + ForTue + ForWed + ForThu + ForFri + ForSat + ForSun) > 0
                        SortDates
                Loop
            End If
        Next
    Next
        StartDay = WeekdayName(IIf(ConvertDay(StartDay) = 6, -1, ConvertDay(StartDay)) Mod 7 + 2)
        RequiredID = 1
     
Next
MousePointer = vbDefault
End Sub
____________________________________________________________________________________________

Public Sub SortDates()
Dim Names As Variant
Dim subtractValue As Long
Dim tempName As String
Dim tempValue As Long
Dim i As Integer
Dim j As Integer
Dim Values As Variant
   
    ' setup the arrays
    Names = Split("ForMon,ForTue,ForWed,ForThu,ForFri,ForSat,ForSun", ",")
    Values = Array(ForMon, ForTue, ForWed, ForThu, ForFri, ForSat, ForSun)

    ' bubble sort 'em
    For i = (UBound(Values) - 1) To 0 Step -1
        For j = 0 To i
            If Values(j) > Values(j + 1) Then
                ' swap values
                tempValue = Values(j)
                Values(j) = Values(j + 1)
                Values(j + 1) = tempValue
               
                ' swap names
                tempName = Names(j)
                Names(j) = Names(j + 1)
                Names(j + 1) = tempName
            End If
        Next j
    Next i
   
    ' find the first nonzero value starting with third position
   
    For i = 2 To UBound(Values)
        subtractValue = Values(i)
        If subtractValue > 0 Then
            Exit For
        End If
    Next i
   
    For i = 0 To UBound(Names)
            Select Case Names(i)
                Case "ForMon"
                    YNmon = IIf(Values(i) = 0, "", "Y")
                Case "ForTue"
                    YNtue = IIf(Values(i) = 0, "", "Y")
                Case "ForWed"
                    YNwed = IIf(Values(i) = 0, "", "Y")
                Case "ForThu"
                    YNthu = IIf(Values(i) = 0, "", "Y")
                Case "ForFri"
                    YNfri = IIf(Values(i) = 0, "", "Y")
                Case "ForSat"
                    YNsat = IIf(Values(i) = 0, "", "Y")
                Case "ForSun"
                    YNsun = IIf(Values(i) = 0, "", "Y")
            End Select
    Next
    For i = 0 To 1
            Select Case Names(i)
                Case "ForMon"
                    YNmon = ""
                Case "ForTue"
                    YNtue = ""
                Case "ForWed"
                    YNwed = ""
                Case "ForThu"
                    YNthu = ""
                Case "ForFri"
                    YNfri = ""
                Case "ForSat"
                    YNsat = ""
                Case "ForSun"
                    YNsun = ""
            End Select
    Next

            For E = 1 To subtractValue
                W = W + 1
               '---------------------------------subtract 2 from required to get the proper time
               'If M = 2 Then RequiredIDD -1
                SQL = "INSERT INTO forecastsched SELECT * FROM binary1 where binaryid =" & (RequiredIDD * 40) - 40 + W & ""
                RSforecast.Open SQL, cnForecast, adOpenKeyset, adLockReadOnly
               
                '-------------------CREATE 'Y' or NULL FOR DAYS
                'this create the unique ID for overlap from monday to tuesday
                    If RequiredIDD > 30 Then
                        SQL = "UPDATE forecastsched " & _
                        "SET monday =  '" & YNmon & "'," & _
                        " tuesday = '" & YNtue & "'," & _
                        " wednesday = '" & YNwed & "'," & _
                        " thursday = '" & YNthu & "'," & _
                        " friday = '" & YNfri & "'," & _
                        " saturday = '" & YNsat & "'," & _
                        " sunday = '" & YNsun & "', " & _
                        " crossover = 'Y' " & _
                        " where forecastid= (SELECT max(forecastid) from forecastsched)"
                    Else
                        SQL = "UPDATE forecastsched " & _
                        "SET monday =  '" & YNmon & "'," & _
                        " tuesday = '" & YNtue & "'," & _
                        " wednesday = '" & YNwed & "'," & _
                        " thursday = '" & YNthu & "'," & _
                        " friday = '" & YNfri & "'," & _
                        " saturday = '" & YNsat & "', " & _
                        " sunday = '" & YNsun & "' " & _
                        " where forecastid= (SELECT max(forecastid) from forecastsched)"
                    End If
                RSforecast.Open SQL, cnForecast, adOpenKeyset, adLockReadOnly
                '----------RESET THE GETTING OF SCHEDULES BACK TO 1
                If W Mod 20 = 0 Then W = IIf(ForReq < Needed, 20, 0)
                   
            Next
        'SortALL AND SUBTRACT TO GET THE REAL VALUE------------EE



    ' starting with third position, if value is greater than zero
    ' then subtract the value from it
    For i = 2 To UBound(Names)
        If Values(i) > 0 Then
            Values(i) = Values(i) - subtractValue
           
            ' update the actual variable with new value
            Select Case Names(i)
                Case "ForMon"
                    ForMon = Values(i)
                Case "ForTue"
                    ForTue = Values(i)
                Case "ForWed"
                    ForWed = Values(i)
                Case "ForThu"
                    ForThu = Values(i)
                Case "ForFri"
                    ForFri = Values(i)
                Case "ForSat"
                    ForSat = Values(i)
                Case "ForSun"
                    ForSun = Values(i)
            End Select
        End If
    Next i
   
    ' return string
    'SortDates = output
End Sub
0
lynnton
Asked:
lynnton
  • 10
  • 5
  • 3
1 Solution
 
sudhakar_koundinyaCommented:
CHANGE UR BUBBLE SORT CODE LIKE THIS
0
 
sudhakar_koundinyaCommented:
CHANGE UR BUBBLE SORT CODE LIKE THIS,

Improves the speed a bit

    ' bubble sort 'em
    For i = (UBound(Values) - 1) To 0 Step -1
       Dim swapped As Boolean
       swapped = False
        For j = 0 To i
            If Values(j) > Values(j + 1) Then
                ' swap values
                tempValue = Values(j)
                Values(j) = Values(j + 1)
                Values(j + 1) = tempValue
               
                ' swap names
                tempName = Names(j)
                Names(j) = Names(j + 1)
                Names(j + 1) = tempName
                swapped = True
            End If
        Next j
        If swapped = False Then
           Exit For
        End If
    Next i
0
 
sudhakar_koundinyaCommented:
In SortDates method you are spliting the Names. This is not necessay

Do as suggested below
Dim Names As Variant
Private Sub Form_Load()
    ' setup the arrays
    Names = Split("ForMon,ForTue,ForWed,ForThu,ForFri,ForSat,ForSun", ",")
End Sub
0
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 
sudhakar_koundinyaCommented:
in GenSchedules method

you are doing like this at beginning of method
For Q = RequiredID To EndReq
        For M = 1 To 2
            If M = 2 Then
            'some code
           end if
          if m=1 then
          'some code
          end if


Change above code as below

        For M = 1 To 2
            If M = 2 Then
            'some code
           end if
          elseif m=1 then
          'some code
          end if
0
 
sudhakar_koundinyaCommented:
Below code might help you






Dim names(0 To 8) As String
Dim YNmon, YNtue, YNWed, YNThu, YNFri, YNSat, YNSun

Private Sub Command1_Click()
    MousePointer = vbHourglass
    Set RSforecast = New ADODB.Recordset
    RSforecast.CursorLocation = adUseClient

   'get the highest required
    SQL = "SELECT  top 1 dayname FROM " & _
    "( " & _
    "SELECT 'Monday' as DayName, SUM(Monday) As DaySum FROM required " & _
    "Union All " & _
    "SELECT 'Tuesday', SUM(Tuesday) FROM required " & _
    "Union All " & _
    "SELECT 'Wednesday', SUM(Wednesday) FROM required " & _
    "Union All " & _
    "SELECT 'Thursday', SUM(Thursday) FROM required " & _
    "Union All " & _
    "SELECT 'Friday', SUM(Friday) FROM required " & _
    "Union All " & _
    "SELECT 'Saturday', SUM(Saturday) FROM required " & _
    "Union All " & _
    "SELECT 'Sunday', SUM(Sunday) FROM required " & _
    " As B) ORDER BY Daysum desc"
    RSforecast.Open SQL, cnForecast, adOpenKeyset, adLockReadOnly
    StartDay = RSforecast(0).Value
    RSforecast.Close

    '--------------------------------REQURED SCHEDULES
    'get the lowest number of required
    SQL = "SELECT requiredid from required " & _
    "where " & StartDay & " = (select min(" & StartDay & ") from required)"
    RSforecast.Open SQL, cnForecast, adOpenKeyset, adLockReadOnly
    RequiredID = RSforecast(0).Value
    RSforecast.Close

    '-------------loop thought all the records
    LeftOverDay = ConvertDay(StartDay)
    LeftOverTime = RequiredID
    EndReq = 48
    EndDay = 7
    GenSchedules
End Sub
____________________________________________________________________________________________
Public Sub GenSchedules()

For R = ConvertDay(StartDay) To EndDay
    For Q = RequiredID To EndReq
        For M = 1 To 2
            If M = 2 Then
                If Right(StartTime, 2) = "00" Then
                    StartTime = Left(StartTime, 2) & "15"
                Else
                    StartTime = Left(StartTime, 2) & "45"
                End If
           

    '-------------------------------REQUIRED------
             ElseIf M = 1 Then
    SQL = "SELECT time," & StartDay & ",requiredid,monday,tuesday,wednesday,thursday,friday,saturday,sunday " & _
    "from required where requiredid = " & Q & ""
    RSforecast.Open SQL, cnForecast, adOpenKeyset, adLockReadOnly
            StartTime = RSforecast(0).Value
            Needed = RSforecast(1).Value
            RequiredIDD = RSforecast(2).Value
            ReqMon = RSforecast(3).Value
            ReqTue = RSforecast(4).Value
            ReqWed = RSforecast(5).Value
            ReqThu = RSforecast(6).Value
            ReqFri = RSforecast(7).Value
            ReqSat = RSforecast(8).Value
            ReqSun = RSforecast(9).Value
    RSforecast.Close
                End If

    '-------------------------------FORECAST SCHEDULES
    'get all the yes value on days and how many operators are presently seated
    ' GET RECORD WITH CROSSOVER
                If Q < 18 Then
      SQL = "SELECT  DISTINCT " & _
    "(SELECT sum([" & StartTime & "]) as days  FROM forecastsched WHERE (monday = 'Y' and crossover is null) " & _
    "or (sunday = 'Y' and crossover = 'Y')) as Monday, " & _
    "(SELECT sum([" & StartTime & "]) FROM forecastsched WHERE (tuesday = 'Y' and crossover is null) " & _
    "or (monday = 'Y' and crossover = 'Y')) as Tuesday, " & _
    "(SELECT sum([" & StartTime & "]) FROM forecastsched WHERE (wednesday = 'Y'  and crossover is null) " & _
    "or (tuesday = 'Y' and crossover = 'Y')) as Wednesday, " & _
    "(SELECT sum([" & StartTime & "]) FROM forecastsched WHERE (thursday = 'Y'  and crossover is null) " & _
    "or (wednesday = 'Y' and crossover = 'Y')) as Thursday, " & _
    "(SELECT sum([" & StartTime & "]) FROM forecastsched WHERE (friday = 'Y'  and crossover is null) " & _
    "or (thursday = 'Y' and crossover = 'Y')) as Friday, " & _
    "(SELECT sum([" & StartTime & "]) FROM forecastsched WHERE (saturday = 'Y'  and crossover is null) " & _
    "or (friday = 'Y' and crossover = 'Y')) as Saturday, " & _
    "(SELECT sum([" & StartTime & "]) FROM forecastsched WHERE (sunday = 'Y'  and crossover is null) " & _
    "or (saturday = 'Y' and crossover = 'Y')) as Sunday from forecastsched "
                Else
    SQL = "SELECT  DISTINCT " & _
    "(SELECT sum([" & StartTime & "]) as days  FROM forecastsched WHERE monday = 'y') as Monday, " & _
    "(SELECT sum([" & StartTime & "]) FROM forecastsched WHERE tuesday = 'y') as Tuesday, " & _
    "(SELECT sum([" & StartTime & "]) FROM forecastsched WHERE wednesday = 'y') as Wednesday, " & _
    "(SELECT sum([" & StartTime & "]) FROM forecastsched WHERE thursday = 'y') as Thursday, " & _
    "(SELECT sum([" & StartTime & "]) FROM forecastsched WHERE friday = 'y') as Friday, " & _
    "(SELECT sum([" & StartTime & "]) FROM forecastsched WHERE saturday = 'y') as Saturday, " & _
    "(SELECT sum([" & StartTime & "]) FROM forecastsched WHERE sunday = 'y') as Sunday from forecastsched"
                End If
    RSforecast.Open SQL, cnForecast, adOpenKeyset, adLockReadOnly
            If RSforecast.EOF And RSforecast.BOF Then
                Actual = 0
                ForMon = 0
                ForTue = 0
                ForWed = 0
                ForThu = 0
                ForFri = 0
                ForSat = 0
                ForSun = 0
            Else
                Actual = IIf(IsNull(RSforecast(StartDay).Value), 0, RSforecast(StartDay).Value)
                ForMon = IIf(IsNull(RSforecast(0).Value), 0, RSforecast(0).Value)
                ForTue = IIf(IsNull(RSforecast(1).Value), 0, RSforecast(1).Value)
                ForWed = IIf(IsNull(RSforecast(2).Value), 0, RSforecast(2).Value)
                ForThu = IIf(IsNull(RSforecast(3).Value), 0, RSforecast(3).Value)
                ForFri = IIf(IsNull(RSforecast(4).Value), 0, RSforecast(4).Value)
                ForSat = IIf(IsNull(RSforecast(5).Value), 0, RSforecast(5).Value)
                ForSun = IIf(IsNull(RSforecast(6).Value), 0, RSforecast(6).Value)
            End If
    RSforecast.Close

            If Needed > Actual Then
            'need to get different schedules, odd number and record what was the last schedule given then follow on
           
    '-------------------------------REQUIRED FORCAST TREND
                If Q = 48 Then
                    SQL = "SELECT " & WeekdayName(IIf(ConvertDay(StartDay) = 6, -1, ConvertDay(StartDay)) Mod 7 + 2) & "" & _
                        " from required where requiredid = 1"
                Else
                    SQL = "SELECT " & StartDay & " from required where requiredid = " & Q + 1 & ""
                End If
            RSforecast.Open SQL, cnForecast, adOpenKeyset, adLockReadOnly
            ForReq = RSforecast(0).Value
            RSforecast.Close
            'PercentDiff = ((ForReq / Needed) * 100) - 100
            W = 0

            If ForReq < Needed Then W = W + 20

            ForMon = IIf((ReqMon - ForMon) > 0, ReqMon - ForMon, 0)
            ForTue = IIf((ReqTue - ForTue) > 0, ReqTue - ForTue, 0)
            ForWed = IIf((ReqWed - ForWed) > 0, ReqWed - ForWed, 0)
            ForThu = IIf((ReqThu - ForThu) > 0, ReqThu - ForThu, 0)
            ForFri = IIf((ReqFri - ForFri) > 0, ReqFri - ForFri, 0)
            ForSat = IIf((ReqSat - ForSat) > 0, ReqSat - ForSat, 0)
            ForSun = IIf((ReqSun - ForSun) > 0, ReqSun - ForSun, 0)

                Do While (ForMon + ForTue + ForWed + ForThu + ForFri + ForSat + ForSun) > 0
                        SortDates
                Loop
            End If
        Next
    Next
        StartDay = WeekdayName(IIf(ConvertDay(StartDay) = 6, -1, ConvertDay(StartDay)) Mod 7 + 2)
        RequiredID = 1
     
Next
MousePointer = vbDefault
End Sub
____________________________________________________________________________________________

Public Sub SortDates()

Dim subtractValue As Long
Dim tempName As String
Dim tempValue As Long
Dim i As Integer
Dim j As Integer
Dim Values As Variant
   
    names(0) = "ForMon"
    names(1) = "ForTue"
    names(2) = "ForWed"
    names(3) = "ForThu"
    names(4) = "ForFri"
    names(5) = "ForSat"
    names(6) = "ForSun"
    names(7) = ""
   
    Values = Array(ForMon, ForTue, ForWed, ForThu, ForFri, ForSat, ForSun)

    ' bubble sort 'em
    For i = (UBound(Values) - 1) To 0 Step -1
       Dim swapped As Boolean
       swapped = False
        For j = 0 To i
            If Values(j) > Values(j + 1) Then
                ' swap values
                tempValue = Values(j)
                Values(j) = Values(j + 1)
                Values(j + 1) = tempValue
               
                ' swap names
                tempName = names(j)
                names(j) = names(j + 1)
                names(j + 1) = tempName
                swapped = True
            End If
        Next j
        If swapped = False Then
           Exit For
        End If
    Next i
   
    ' find the first nonzero value starting with third position
   
    For i = 2 To UBound(Values)
       
        If Values(i) > 0 Then
        subtractValue = Values(i)
            Exit For
        End If
    Next i
   
    For i = 0 To UBound(names)
            Select Case names(i)
                Case "ForMon"
                    YNmon = IIf(Values(i) = 0, "", "Y")
                Case "ForTue"
                    YNtue = IIf(Values(i) = 0, "", "Y")
                Case "ForWed"
                    YNWed = IIf(Values(i) = 0, "", "Y")
                Case "ForThu"
                    YNThu = IIf(Values(i) = 0, "", "Y")
                Case "ForFri"
                    YNFri = IIf(Values(i) = 0, "", "Y")
                Case "ForSat"
                    YNSat = IIf(Values(i) = 0, "", "Y")
                Case "ForSun"
                    YNSun = IIf(Values(i) = 0, "", "Y")
            End Select
    Next
    For i = 0 To 1
            Select Case names(i)
                Case "ForMon"
                    YNmon = ""
                Case "ForTue"
                    YNtue = ""
                Case "ForWed"
                    YNWed = ""
                Case "ForThu"
                    YNThu = ""
                Case "ForFri"
                    YNFri = ""
                Case "ForSat"
                    YNSat = ""
                Case "ForSun"
                    YNSun = ""
            End Select
    Next

        If RequiredIDD > 30 Then
        update1 (RequiredIDD)
        Else
        update2 (RequiredIDD)
        End If
           
        'SortALL AND SUBTRACT TO GET THE REAL VALUE------------EE



    ' starting with third position, if value is greater than zero
    ' then subtract the value from it
    For i = 2 To UBound(names)
        If Values(i) > 0 Then
            Values(i) = Values(i) - subtractValue
           
            ' update the actual variable with new value
            Select Case names(i)
                Case "ForMon"
                    ForMon = Values(i)
                Case "ForTue"
                    ForTue = Values(i)
                Case "ForWed"
                    ForWed = Values(i)
                Case "ForThu"
                    ForThu = Values(i)
                Case "ForFri"
                    ForFri = Values(i)
                Case "ForSat"
                    ForSat = Values(i)
                Case "ForSun"
                    ForSun = Values(i)
            End Select
        End If
    Next i
   
    ' return string
    'SortDates = output
End Sub

Private Sub Form_Load()
    ' setup the arrays
   

   
   
End Sub



Private Sub update1(id As Integer)

For E = 1 To subtractValue
                W = W + 1
               '---------------------------------subtract 2 from required to get the proper time
               'If M = 2 Then RequiredIDD -1
                SQL = "INSERT INTO forecastsched SELECT * FROM binary1 where binaryid =" & (id * 40) - 40 + W & ""
                RSforecast.Open SQL, cnForecast, adOpenKeyset, adLockReadOnly
               
                '-------------------CREATE 'Y' or NULL FOR DAYS
                'this create the unique ID for overlap from monday to tuesday
                   
                        SQL = "UPDATE forecastsched " & _
                        "SET monday =  '" & YNmon & "'," & _
                        " tuesday = '" & YNtue & "'," & _
                        " wednesday = '" & YNWed & "'," & _
                        " thursday = '" & YNThu & "'," & _
                        " friday = '" & YNFri & "'," & _
                        " saturday = '" & YNSat & "'," & _
                        " sunday = '" & YNSun & "', " & _
                        " crossover = 'Y' " & _
                        " where forecastid= (SELECT max(forecastid) from forecastsched)"
                   
                RSforecast.Open SQL, cnForecast, adOpenKeyset, adLockReadOnly
                '----------RESET THE GETTING OF SCHEDULES BACK TO 1
                If W Mod 20 = 0 Then W = IIf(ForReq < Needed, 20, 0)
                   
            Next
End Sub


Private Sub update2(id As Integer)
For E = 1 To subtractValue
                W = W + 1
               '---------------------------------subtract 2 from required to get the proper time
               'If M = 2 Then RequiredIDD -1
                SQL = "INSERT INTO forecastsched SELECT * FROM binary1 where binaryid =" & (id * 40) - 40 + W & ""
                RSforecast.Open SQL, cnForecast, adOpenKeyset, adLockReadOnly
               
                '-------------------CREATE 'Y' or NULL FOR DAYS
                'this create the unique ID for overlap from monday to tuesday
                        SQL = "UPDATE forecastsched " & _
                        "SET monday =  '" & YNmon & "'," & _
                        " tuesday = '" & YNtue & "'," & _
                        " wednesday = '" & YNWed & "'," & _
                        " thursday = '" & YNThu & "'," & _
                        " friday = '" & YNFri & "'," & _
                        " saturday = '" & YNSat & "', " & _
                        " sunday = '" & YNSun & "' " & _
                        " where forecastid= (SELECT max(forecastid) from forecastsched)"
                RSforecast.Open SQL, cnForecast, adOpenKeyset, adLockReadOnly
                '----------RESET THE GETTING OF SCHEDULES BACK TO 1
                If W Mod 20 = 0 Then W = IIf(ForReq < Needed, 20, 0)
                   
            Next


End Sub


0
 
Mike EghtebasDatabase and Application DeveloperCommented:
It might a bit late to redesign table structure or maybe not.  It is for you to decid:

tblWeekdays
-------------------
WeekDayID (Autonumber)
WeekDayName  (text)


tbl15minutePeriod
-----------------------
PeriodID (autonumber)
PeriodName (single)  use 0.25, 0.50, 0.75, 1.00 for 00:15 (am), 00:30 (am), etc.  (easy to calculate)
.
.

tblBinary1
--------------------
BinaryID (autonumber)
WeekDay_ID (number/Long)
Period_ID (number/Long)
BinaryData1
BinaryData2  (as applicable)

tblRequired
--------------------
ForcastSchedID (autonumber)
WeekDay_ID (number/Long)
Period_ID (number/Long)
RequiredData1
RequiredData2  (as applicable)

tblForcastSched
--------------------
BinaryID (autonumber)
WeekDay_ID (number/Long)
Period_ID (number/Long)
ForcastSchedData1
ForcastSchedData2  (as applicable)

This will speed up your queries.  Also, consider making some of the queries local to access, especially those involving calculation.  This will reduce server traffic also and speed up your work.  Then make your SQL using that nammed query to access the database.  (Someone suggested once, after making the queries in access, save them two time which then are kept in compile state).

Regards,

Mike
0
 
lynntonAuthor Commented:
sudhakar_koundinya,

There seems to be a confusion, do you want me to use

Option explicit
Dim names(0 To 8) As String
'or
Dim names as Variant

Thanks,
Lynnton
0
 
lynntonAuthor Commented:
Mike,

Also, consider making some of the queries local to access, especially those involving calculation.  This will reduce server traffic also and speed up your work.  Then make your SQL using that nammed query to access the database.  (Someone suggested once, after making the queries in access, save them two time which then are kept in compile state).
<----

Please show a sample.
i'm using vb6 with ms access

Thanks,
Lynnton
0
 
sudhakar_koundinyaCommented:
use this


Option explicit
Dim names(0 To 8) As String
0
 
Mike EghtebasDatabase and Application DeveloperCommented:
>>>Replace following:

Private Sub Command1_Click()
    MousePointer = vbHourglass
    Set RSforecast = New ADODB.Recordset
    .
    .
    GenSchedules
End Sub

>>>With:

Private Sub Command1_Click()
    MousePointer = vbHourglass
    Set RSforecast = New ADODB.Recordset
    RSforecast.CursorLocation = adUseClient

   'get the highest required
    SQL = "SELECT  top 1 dayname FROM qMyAccessQuery1"    RSforecast.Open SQL, cnForecast, adOpenKeyset, adLockReadOnly
    StartDay = RSforecast(0).Value
    RSforecast.Close

    '--------------------------------REQURED SCHEDULES
    'get the lowest number of required
    SQL = "SELECT requiredid from required " & _
    "where " & StartDay & " = (select min(" & StartDay & ") from required)"
    RSforecast.Open SQL, cnForecast, adOpenKeyset, adLockReadOnly
    RequiredID = RSforecast(0).Value
    RSforecast.Close

    '-------------loop thought all the records
    LeftOverDay = ConvertDay(StartDay)
    LeftOverTime = RequiredID
    EndReq = 48
    EndDay = 7
    GenSchedules
End Sub

>>>Where, in Ms Access you have query qMyAccessQuery1 saved, with SQL of:

SELECT "Monday" as DayName, SUM(Monday) As DaySum FROM required Union All SELECT "Tuesday", SUM(Tuesday) FROM required Union All SELECT "Wednesday", SUM(Wednesday) FROM required Union All SELECT "Thursday", SUM(Thursday) FROM required Union All SELECT "Friday", SUM(Friday) FROM required Union All SELECT "Saturday", SUM(Saturday) FROM required Union All SELECT "Sunday", SUM(Sunday) FROM required As B) ORDER BY Daysum desc"

>>>FYI, just incas, start a new query in Access, add any table to it.  While in design view of QBE, from the menu select View/SQL and replace its content with the above SQL string just as is.  Then save it as qMyAccessQuery1.

mike
0
 
lynntonAuthor Commented:
Mike

I'm having a hard time placing querys to MS access, systex error, please help me out.

Thanks,
Lynnton
0
 
lynntonAuthor Commented:
Mike,

The following queries please.

Thanks,
Lynnton

__________________________first query
    SQL = "SELECT time," & StartDay & ",requiredid,monday,tuesday,wednesday,thursday,friday,saturday,sunday " & _
    "from required where requiredid = " & Q & ""
    RSforecast.Open SQL, cnForecast, adOpenKeyset, adLockReadOnly

__________________________second query
      SQL = "SELECT  DISTINCT " & _
    "(SELECT sum([" & StartTime & "]) as days  FROM forecastsched WHERE (monday = 'Y' and crossover is null) " & _
    "or (sunday = 'Y' and crossover = 'Y')) as Monday, " & _
    "(SELECT sum([" & StartTime & "]) FROM forecastsched WHERE (tuesday = 'Y' and crossover is null) " & _
    "or (monday = 'Y' and crossover = 'Y')) as Tuesday, " & _
    "(SELECT sum([" & StartTime & "]) FROM forecastsched WHERE (wednesday = 'Y'  and crossover is null) " & _
    "or (tuesday = 'Y' and crossover = 'Y')) as Wednesday, " & _
    "(SELECT sum([" & StartTime & "]) FROM forecastsched WHERE (thursday = 'Y'  and crossover is null) " & _
    "or (wednesday = 'Y' and crossover = 'Y')) as Thursday, " & _
    "(SELECT sum([" & StartTime & "]) FROM forecastsched WHERE (friday = 'Y'  and crossover is null) " & _
    "or (thursday = 'Y' and crossover = 'Y')) as Friday, " & _
    "(SELECT sum([" & StartTime & "]) FROM forecastsched WHERE (saturday = 'Y'  and crossover is null) " & _
    "or (friday = 'Y' and crossover = 'Y')) as Saturday, " & _
    "(SELECT sum([" & StartTime & "]) FROM forecastsched WHERE (sunday = 'Y'  and crossover is null) " & _
    "or (saturday = 'Y' and crossover = 'Y')) as Sunday from forecastsched "

_____________________________third query
    SQL = "SELECT  DISTINCT " & _
    "(SELECT sum([" & StartTime & "]) as days  FROM forecastsched WHERE monday = 'y') as Monday, " & _
    "(SELECT sum([" & StartTime & "]) FROM forecastsched WHERE tuesday = 'y') as Tuesday, " & _
    "(SELECT sum([" & StartTime & "]) FROM forecastsched WHERE wednesday = 'y') as Wednesday, " & _
    "(SELECT sum([" & StartTime & "]) FROM forecastsched WHERE thursday = 'y') as Thursday, " & _
    "(SELECT sum([" & StartTime & "]) FROM forecastsched WHERE friday = 'y') as Friday, " & _
    "(SELECT sum([" & StartTime & "]) FROM forecastsched WHERE saturday = 'y') as Saturday, " & _
    "(SELECT sum([" & StartTime & "]) FROM forecastsched WHERE sunday = 'y') as Sunday from forecastsched"

________________________________fourth query
                        SQL = "UPDATE forecastsched " & _
                        "SET monday =  '" & YNmon & "'," & _
                        " tuesday = '" & YNtue & "'," & _
                        " wednesday = '" & YNwed & "'," & _
                        " thursday = '" & YNthu & "'," & _
                        " friday = '" & YNfri & "'," & _
                        " saturday = '" & YNsat & "'," & _
                        " sunday = '" & YNsun & "', " & _
                        " crossover = 'Y' " & _
                        " where forecastid= (SELECT max(forecastid) from forecastsched)"

0
 
lynntonAuthor Commented:
sudhakar_koundinya,

error cannot assign to array
names <---

Thanks,
Lynnton
0
 
Mike EghtebasDatabase and Application DeveloperCommented:
Try:    extra      As B)   was in the string

SELECT "Monday" as DayName, SUM(Monday) As DaySum FROM required Union All SELECT "Tuesday", SUM(Tuesday) FROM required Union All SELECT "Wednesday", SUM(Wednesday) FROM required Union All SELECT "Thursday", SUM(Thursday) FROM required Union All SELECT "Friday", SUM(Friday) FROM required Union All SELECT "Saturday", SUM(Saturday) FROM required Union All SELECT "Sunday", SUM(Sunday) FROM required ORDER BY Daysum desc"
0
 
sudhakar_koundinyaCommented:
It shoould not give a problem

Dim names(0 To 8) As String

Private Sub SortDates()
  names(0) = "ForMon"
    names(1) = "ForTue"
    names(2) = "ForWed"
    names(3) = "ForThu"
    names(4) = "ForFri"
    names(5) = "ForSat"
    names(6) = "ForSun"
    names(7) = ""
End Sub

Private Sub Command1_Click()
       SortDates
End Sub
0
 
sudhakar_koundinyaCommented:
Are you doing following basic things

in forecastsched forecastid should be primary
create relation between

Considering your fourth query

                       SQL = "UPDATE forecastsched " & _
                        "SET monday =  '" & YNmon & "'," & _
                        " tuesday = '" & YNtue & "'," & _
                        " wednesday = '" & YNwed & "'," & _
                        " thursday = '" & YNthu & "'," & _
                        " friday = '" & YNfri & "'," & _
                        " saturday = '" & YNsat & "'," & _
                        " sunday = '" & YNsun & "', " & _
                        " crossover = 'Y' " & _
                        " where forecastid= (SELECT max(forecastid) from forecastsched)"


Theoritically speaking you are updating this table from two tables which leads to crossing of two tables

When working with one table I would prefer to break the SQL, something like below

SQL=(SELECT max(forecastid) from forecastsched);

' get the value from record set say maxforecastid

'now create the table using following update statement.
                       SQL = "UPDATE forecastsched " & _
                        "SET monday =  '" & YNmon & "'," & _
                        " tuesday = '" & YNtue & "'," & _
                        " wednesday = '" & YNwed & "'," & _
                        " thursday = '" & YNthu & "'," & _
                        " friday = '" & YNfri & "'," & _
                        " saturday = '" & YNsat & "'," & _
                        " sunday = '" & YNsun & "', " & _
                        " crossover = 'Y' " & _
                        " where forecastid=" & maxforecastid


This model may communicate to database for 2 times, but will not cross the same table.
0
 
sudhakar_koundinyaCommented:
>>create relation between
create relation between tables
0
 
sudhakar_koundinyaCommented:
your second and third queries are little confusing but what I understood is it takes maximum time to execute query. (Same  problem in this scenario also crossing of same table)

Any ways let me try to analyse ur 2 queries
0

Featured Post

VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

  • 10
  • 5
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now