PDA

View Full Version : Need Help Combining 5 Macro's into 1 Macro



bubbapost
03-26-2010, 11:38 AM
Hello,

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

Any Suggestions would be appreciated :hi:

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


Thank you!

SamT
03-26-2010, 12:12 PM
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.

Paul_Hossler
03-26-2010, 06:08 PM
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


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