Consulting

Results 1 to 3 of 3

Thread: Need Help Combining 5 Macro's into 1 Macro

  1. #1

    Post Need Help Combining 5 Macro's into 1 Macro

    Hello,

    I need help combining the 5 macro's below into one.

    Any Suggestions would be appreciated

    [VBA]Option Explicit
    Const StartRow = 2
    Const EndRow = 3
    Const StartCol = 3
    Const Brk1Start = 4
    Const Brk1End = 5
    Const LunchStart = 6
    Const LunchEnd = 7
    Const Brk2Start = 8
    Const Brk2End = 9
    Const StopCol = 10
    Const DivCol = 13
    Const M1Col = 14
    Const M2Col = 15
    Const M3Col = 16
    Const M4Col = 17
    Const M5Col = 18

    Sub ScheduleTrainingCS1()
    Dim Counter As Range
    Set WBT = ActiveWorkbook
    Set WSD = WBT.Worksheets("Dashboard")
    Set WSC = WBT.Worksheets("Combined")
    Set WSTI = WBT.Worksheets("Training Info")
    Set CSCap = WSTI.Range("CSAgent_Cap")
    Set Counter = WSD.Range("E3")
    FinalRow = WSC.Cells(Rows.Count, 1).End(xlUp).Row
    For i = 4 To FinalRow
    If Cells(i, StartCol) <= Cells(StartRow, M1Col) Then
    If Cells(i, Brk1End) < Cells(StartRow, M1Col) Then
    If Cells(i, DivCol) = "CS" Then
    Cells(i, M1Col).Value = "1"
    If Counter.Value = CSCap.Value Then Exit Sub
    End If
    End If
    End If
    Next i
    End Sub

    Sub ScheduleTrainingCS2()
    Dim Counter As Range
    Set WBT = ActiveWorkbook
    Set WSD = WBT.Worksheets("Dashboard")
    Set WSC = WBT.Worksheets("Combined")
    Set WSTI = WBT.Worksheets("Training Info")
    Set CSCap = WSTI.Range("CSAgent_Cap")
    Set Counter = WSD.Range("E3")
    FinalRow = WSC.Cells(Rows.Count, 1).End(xlUp).Row
    For i = 4 To FinalRow
    If Cells(i, StartCol) <= Cells(StartRow, M1Col) Then
    If Cells(i, Brk1Start) >= Cells(EndRow, M1Col) Then
    If Cells(i, DivCol) = "CS" Then
    Cells(i, M1Col).Value = "1"
    If Counter.Value = CSCap.Value Then Exit Sub
    End If
    End If
    End If
    Next i
    End Sub

    Sub ScheduleTrainingCSA1()
    Dim Counter As Range
    Set WBT = ActiveWorkbook
    Set WSD = WBT.Worksheets("Dashboard")
    Set WSC = WBT.Worksheets("Combined")
    Set WSTI = WBT.Worksheets("Training Info")
    Set CSCap = WSTI.Range("CSAgent_Cap")
    Set Counter = WSD.Range("E3")
    FinalRow = WSC.Cells(Rows.Count, 1).End(xlUp).Row
    For i = 4 To FinalRow
    If Cells(i, StartCol) <= Cells(StartRow, M1Col) Then
    If Cells(i, Brk1Start) >= Cells(EndRow, M1Col) Then
    If Cells(i, DivCol) = "CS" Then
    If Cells(i, M1Col) <> "1" Then
    Cells(i, M1Col).Value = "A"
    End If
    End If
    End If
    End If
    Next i
    End Sub

    Sub ScheduleTrainingCSA2()
    Dim Counter As Range
    Set WBT = ActiveWorkbook
    Set WSD = WBT.Worksheets("Dashboard")
    Set WSC = WBT.Worksheets("Combined")
    Set WSTI = WBT.Worksheets("Training Info")
    Set CSCap = WSTI.Range("CSAgent_Cap")
    Set Counter = WSD.Range("E3")
    FinalRow = WSC.Cells(Rows.Count, 1).End(xlUp).Row
    For i = 4 To FinalRow
    If Cells(i, StartCol) <= Cells(StartRow, M1Col) Then
    If Cells(i, Brk1End) < Cells(StartRow, M1Col) Then
    If Cells(i, DivCol) = "CS" Then
    If Cells(i, M1Col) <> "1" Then
    Cells(i, M1Col).Value = "A"
    End If
    End If
    End If
    End If
    Next i
    End Sub

    Sub ScheduleTrainingCSA3()
    Dim Counter As Range
    Set WBT = ActiveWorkbook
    Set WSD = WBT.Worksheets("Dashboard")
    Set WSC = WBT.Worksheets("Combined")
    Set WSTI = WBT.Worksheets("Training Info")
    Set CSCap = WSTI.Range("CSAgent_Cap")
    Set Counter = WSD.Range("E3")
    FinalRow = WSC.Cells(Rows.Count, 1).End(xlUp).Row
    For i = 4 To FinalRow
    If Cells(i, DivCol) = "CS" Then
    If Cells(i, M1Col) = "" Then
    Cells(i, M1Col).Value = "A"
    End If
    End If
    Next i
    End Sub
    [/VBA]

    Thank you!

  2. #2
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,814
    Location
    Can't be done.

    Sub ScheduleTrainingCS1()
    and
    Sub ScheduleTrainingCS2()
    are identical.

    Sub ScheduleTrainingCSA1()
    and
    Sub ScheduleTrainingCSA2()
    and
    Sub ScheduleTrainingCSA3()
    are also identical except for these two lines:
    If Cells(i, M1Col) = "" Then
    and
    If Cells(i, M1Col) <> "1" Then

    Another reason they can't be combined is this line in Subs CS1 and CS2;
    If Cells(i, DivCol) = "CS" Then
    Cells(i, M1Col).Value = "1"
    compare to these two in the CSA subs
    If Cells(i, M1Col) <> "1" Then
    Cells(i, M1Col).Value = "A"


    Now, If you rewrite the rest of the code in the system so that it called Sub ScheduleTraining(TrainingType) where TrainingType was one of CS1,CS2,CSA1,CSA2,or CSA3, then we can do something with a Case Select. Statement.

  3. #3
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,730
    Location
    Whey you say "combine" do you mean

    1. Run all 5 one after another, or
    2. Come up with one Sub that is flexible enough to do 5 different things?

    Some seem to be identical ScheduleTrainingCS1 and ScheduleTrainingCS2

    So why have 2?

    Paul

    Added: If it is #2 then something like this as a starting point maybe

    [VBA]
    Option Explicit
    Public Const StartRow = 2
    Public Const EndRow = 3
    Public Const StartCol = 3
    Public Const Brk1Start = 4
    Public Const Brk1End = 5
    Public Const LunchStart = 6
    Public Const LunchEnd = 7
    Public Const Brk2Start = 8
    Public Const Brk2End = 9
    Public Const StopCol = 10
    Public Const DivCol = 13
    Public Const M1Col = 14
    Public Const M2Col = 15
    Public Const M3Col = 16
    Public Const M4Col = 17
    Public Const M5Col = 18

    Public Enum TypeTraining
    CS1 = 1
    CS2 = 2
    CSA1 = 3
    CSA2 = 4
    CSA3 = 5
    End Enum


    Sub ScheduleTraining(WhatType As TypeTraining)
    Dim Counter As Range
    Dim WBT As Workbook
    Dim WSD As Worksheet, WSC As Worksheet, WSTI As Worksheet
    Dim CsCap As Range, FinalRow As Range
    Dim i As Long


    Set WBT = ActiveWorkbook
    Set WSD = WBT.Worksheets("Dashboard")
    Set WSC = WBT.Worksheets("Combined")
    Set WSTI = WBT.Worksheets("Training Info")
    Set CsCap = WSTI.Range("CSAgent_Cap")
    Set Counter = WSD.Range("E3")
    FinalRow = WSC.Cells(Rows.Count, 1).End(xlUp).Row

    Select Case WhatType
    Case CS1, CS2
    For i = 4 To FinalRow
    If Cells(i, StartCol) <= Cells(StartRow, M1Col) Then
    If Cells(i, Brk1End) < Cells(StartRow, M1Col) Then
    If Cells(i, DivCol) = "CS" Then
    Cells(i, M1Col).Value = "1"
    If Counter.Value = CsCap.Value Then Exit Sub
    End If
    End If
    End If
    Next i

    Case CSA1, CSA2
    For i = 4 To FinalRow
    If Cells(i, StartCol) <= Cells(StartRow, M1Col) Then
    If Cells(i, Brk1Start) >= Cells(EndRow, M1Col) Then
    If Cells(i, DivCol) = "CS" Then
    If Cells(i, M1Col) <> "1" Then
    Cells(i, M1Col).Value = "A"
    End If
    End If
    End If
    End If
    Next i
    Case CSA3
    For i = 4 To FinalRow
    If Cells(i, DivCol) = "CS" Then
    If Cells(i, M1Col) = "" Then
    Cells(i, M1Col).Value = "A"
    End If
    End If
    Next i

    Case Else
    MsgBox "I don't know what to do"
    End Select

    End Sub
    [/VBA]
    Last edited by Paul_Hossler; 03-26-2010 at 06:19 PM.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •