PDA

View Full Version : Help Combining Two Private Sub's Into One


nathandavies
03-16-2018, 03:10 AM
Hi All,
I have two two Sub's that I have created, they both work individually but i'm struggling to get them to work together when i merge them into one.

Any Help on this would be greatly appreciated.

Code 1


Private Sub Worksheet_Change(ByVal Target As Range)
Dim Strt As String
On Error GoTo Oops
If blnAutoOp = True Then Exit Sub
Target.ClearComments
' Mark last change column
' If Target.Column <> LastChangeCol Then Excel.Workbooks(WorkbookName).Worksheets("WIP").Cells(Target.Row, LastChangeCol) = Environ("username")
' If the Contract Number is added or changed, check the Sorting order:
If Target.Column = 1 And Target.Row >= 2 Then
If Target.Row = 2 Then
AddNewJob
Strt = Excel.Workbooks(WorkbookName).Worksheets("WIP").Cells(3, JobNoCol)
SortSheet "WIP", 3
GoToJob Strt, 2
Exit Sub
End If
Strt = Target.Text
SortSheet "WIP", 3
GoToJob Strt, 2
End If


'If Excel.Workbooks(WorkbookName).Worksheets("WIP").Cells(Target.Row, StatCol) = "" And Target.Row >= 2 Then
' Ask if user wants to force NA in non-electrical columns
If Target.Column = ProjElecEngCol Then
If Target.Value = "N/A" Then
If MsgBox("No Electrical Engineer:" & vbCr & "Would you like to force all Electrical deliverables to 'N/A'?", vbQuestion + vbYesNo + vbDefaultButton2, "No Electrical Engineer") = vbYes Then
Excel.Workbooks(WorkbookName).Worksheets("WIP").Cells(Target.Row, SysArchCol) = "N/A"
Excel.Workbooks(WorkbookName).Worksheets("WIP").Cells(Target.Row, SchemesCol) = "N/A"
Excel.Workbooks(WorkbookName).Worksheets("WIP").Cells(Target.Row, LoopsCol) = "N/A"
Excel.Workbooks(WorkbookName).Worksheets("WIP").Cells(Target.Row, TechFileCol) = "N/A"
Excel.Workbooks(WorkbookName).Worksheets("WIP").Cells(Target.Row, ElecOrderCol) = "N/A"
Excel.Workbooks(WorkbookName).Worksheets("WIP").Cells(Target.Row, ElecReqCol) = "N/A"
Excel.Workbooks(WorkbookName).Worksheets("WIP").Cells(Target.Row, ShopFloorFileCol) = "N/A"
Excel.Workbooks(WorkbookName).Worksheets("WIP").Cells(Target.Row, TestCol) = "N/A"
End If
End If
End If


' Ask if user wants to force NA in non-mechanical columns
If Target.Column = ProjMechEngCol Then
If Target.Value = "N/A" Then
If MsgBox("No CAD Engineer:" & vbCr & "Would you like to force all CAD deliverables to 'N/A'?", vbQuestion + vbYesNo + vbDefaultButton2, "No Mechanical Engineer") = vbYes Then
Excel.Workbooks(WorkbookName).Worksheets("WIP").Cells(Target.Row, GACol) = "N/A"
Excel.Workbooks(WorkbookName).Worksheets("WIP").Cells(Target.Row, SchemesCol) = "N/A"
Excel.Workbooks(WorkbookName).Worksheets("WIP").Cells(Target.Row, LoopsCol) = "N/A"
Excel.Workbooks(WorkbookName).Worksheets("WIP").Cells(Target.Row, GACol) = "N/A"
Excel.Workbooks(WorkbookName).Worksheets("WIP").Cells(Target.Row, MechDesCol) = "N/A"
End If
End If
End If


' Ask if user wants to force NA in non-software columns
If Target.Column = ProjSoftEngCol Then
If Target.Value = "N/A" Then
If MsgBox("No Software Engineer:" & vbCr & "Would you like to force all Software deliverables to 'N/A'?", vbQuestion + vbYesNo + vbDefaultButton2, "No Software Engineer") = vbYes Then
Excel.Workbooks(WorkbookName).Worksheets("WIP").Cells(Target.Row, PLCOrderCol) = "N/A"
Excel.Workbooks(WorkbookName).Worksheets("WIP").Cells(Target.Row, PLCReqCol) = "N/A"
Excel.Workbooks(WorkbookName).Worksheets("WIP").Cells(Target.Row, IntegrationCol) = "N/A"
End If
End If
End If

' Set the format based on the Status
If Target.Column = StatCol Then
SetStatusFormatting Target.Row
Target.Select

If Target.Column = StatCol Then

If UCase(Target.Text) = "COMPLETE" Or UCase(Target.Text) = "CANCELLED" Then
If MsgBox("Do you want to move this job onto the 'Completed Jobs' sheet?", vbQuestion + vbYesNo + vbDefaultButton2, "Complete Job") = vbYes Then
Excel.Workbooks(WorkbookName).Worksheets("WIP").Rows(Target.Row & ":" & Target.Row).Copy Destination:=Excel.Workbooks(WorkbookName).Worksheets("Completed Jobs").Range("A65536").End(xlUp).Offset(1, 0)
Excel.Workbooks(WorkbookName).Worksheets("WIP").Rows(Target.Row & ":" & Target.Row).Delete Shift:=xlUp
SortSheet "Completed Jobs", 2
End If
End If

If UCase(Target.Text) = "FINAL O&MS" Then
If MsgBox("Do you want to move this job onto the 'O&M to do' sheet?", vbQuestion + vbYesNo + vbDefaultButton2, "Final O&Ms") = vbYes Then
Excel.Workbooks(WorkbookName).Worksheets("WIP").Rows(Target.Row & ":" & Target.Row).Copy Destination:=Excel.Workbooks(WorkbookName).Worksheets("O&M to do").Range("A65536").End(xlUp).Offset(1, 0)
Excel.Workbooks(WorkbookName).Worksheets("WIP").Rows(Target.Row & ":" & Target.Row).Delete Shift:=xlUp
SortSheet "O&M to do", 2
End If
End If

End If
End If


' Set the format of a changed date
If Target.Rows.Count = 1 And Target.Columns.Count = 1 And Target.Row > 1 Then

' Should be a number of days late
If Target.Column >= DateStart And Target.Column <= DateEnd And UCase(Excel.Workbooks(WorkbookName).Worksheets("WIP").Cells(1, Target.Column)) = "DAYS LATE" Then
If Not IsNumeric(Target.Text) And UCase(Target.Text) <> "" Then
MsgBox "The value must be a number", vbOKOnly + vbExclamation
blnAutoOp = True
Cells(Target.Row, Target.Column) = ""
blnAutoOp = False
End If
CheckRow Target.Row
End If

' Should be a date
If Target.Column >= DateStart And Target.Column <= DateEnd And UCase(Excel.Workbooks(WorkbookName).Worksheets("WIP").Cells(1, Target.Column)) <> "DAYS LATE" Then
If (Not IsDate(Target.Text) Or InStr(1, Target.Text, ".")) And UCase(Target.Text) <> "N/A" And UCase(Target.Text) <> "" Then
MsgBox "The value must either be a Date (e.g. 10-Jun) or 'N/A'", vbOKOnly + vbExclamation
blnAutoOp = True
Cells(Target.Row, Target.Column) = ""
blnAutoOp = False
End If
CheckRow Target.Row
End If
If Target.Column = ProjSoftEngCol And Left(UCase(Excel.Workbooks(WorkbookName).Worksheets("WIP").Cells(Target.Row, 1)), 8) = "SO11299P" And Target.Text <> "ND" Then Excel.Workbooks(WorkbookName).Worksheets("WIP").Cells(Target.Row, Target.Column) = "ND"
End If
Oops:
End Sub


Code 2


Public MyInitialValue
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Lastrow As Long
Dim strOld As String
Dim strNew As String
Lastrow = ActiveWorkbook.Sheets("Log").Range("G1").Value
With Target(1)
strNew = .Text
Application.EnableEvents = False
Application.Undo
strOld = .Text
.Value = strNew

Application.EnableEvents = True
ActiveWorkbook.Sheets("Log").Cells(Lastrow + 2, 1) = ActiveCell.Address
ActiveWorkbook.Sheets("Log").Cells(Lastrow + 2, 2) = strOld
ActiveWorkbook.Sheets("Log").Cells(Lastrow + 2, 3) = Target.Value
ActiveWorkbook.Sheets("Log").Cells(Lastrow + 2, 4) = Application.UserName
ActiveWorkbook.Sheets("Log").Cells(Lastrow + 2, 5) = Now

'Write the Change
'ActiveWorkbook.Sheets("Log").Cells(Lastrow + 2, 1) = "WIP " & _
'ActiveCell.Address & " changed to: " & Target.Value & " - " & " Changed From: " & strOld & " - " & Application.UserName & " - " & Now
'Increase the LastRow value by 1
ActiveWorkbook.Sheets("Log").Range("G1").Value = Lastrow + 1
End With
End Sub


Edit - Have reduced my 1st code to just the sub required, i can post my workbook also if required.
SamT
03-16-2018, 08:06 AM
Rename sub "Code1" to Sub "Sub1" and Sub "Code2" to Sub "Sub2" and move them to ThisWorkbook

In a new Workbook_SheetChange sub in THisWorkbook


Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Sh.Name = "???" Then 'Edit Sh.Name to suit
If Target.Column = 1 And Target.Row >= 2 Then
Sub1 Sh, Target
Else
Sub2 Sh, Target
End If
End If
End Sub
Then edit Sub1 and Sub2 to reflect the Sh (Sheet) where needed
nathandavies
03-19-2018, 02:35 AM
Hi SamT,

I have tested your code and i keep getting an error, "Wrong Number Of Arguments or Invalid Property Assignment" I get this error, on the following line.

Sub1 Sh, Target


Full Code - In ThisWorkbook


Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)If Sh.Name = "WIP" Then 'Edit Sh.Name to suit
If Target.Column = 1 And Target.Row >= 2 Then
Sub1 Sh, Target
Else
Sub2 Sh, Target
End If
End If
End Sub
Private Sub Sub1(ByVal Target As Range)
Dim Strt As String
On Error GoTo Oops
If blnAutoOp = True Then Exit Sub
Target.ClearComments
' Mark last change column
' If Target.Column <> LastChangeCol Then Excel.Workbooks(WorkbookName).Worksheets("WIP").Cells(Target.Row, LastChangeCol) = Environ("username")
' If the Contract Number is added or changed, check the Sorting order:
If Target.Column = 1 And Target.Row >= 2 Then
If Target.Row = 2 Then
AddNewJob
Strt = Excel.Workbooks(WorkbookName).Worksheets("WIP").Cells(3, JobNoCol)
SortSheet "WIP", 3
GoToJob Strt, 2
Exit Sub
End If
Strt = Target.Text
SortSheet "WIP", 3
GoToJob Strt, 2
End If




'If Excel.Workbooks(WorkbookName).Worksheets("WIP").Cells(Target.Row, StatCol) = "" And Target.Row >= 2 Then
' Ask if user wants to force NA in non-electrical columns
If Target.Column = ProjElecEngCol Then
If Target.Value = "N/A" Then
If MsgBox("No Electrical Engineer:" & vbCr & "Would you like to force all Electrical deliverables to 'N/A'?", vbQuestion + vbYesNo + vbDefaultButton2, "No Electrical Engineer") = vbYes Then
Excel.Workbooks(WorkbookName).Worksheets("WIP").Cells(Target.Row, SysArchCol) = "N/A"
Excel.Workbooks(WorkbookName).Worksheets("WIP").Cells(Target.Row, SchemesCol) = "N/A"
Excel.Workbooks(WorkbookName).Worksheets("WIP").Cells(Target.Row, LoopsCol) = "N/A"
Excel.Workbooks(WorkbookName).Worksheets("WIP").Cells(Target.Row, TechFileCol) = "N/A"
Excel.Workbooks(WorkbookName).Worksheets("WIP").Cells(Target.Row, ElecOrderCol) = "N/A"
Excel.Workbooks(WorkbookName).Worksheets("WIP").Cells(Target.Row, ElecReqCol) = "N/A"
Excel.Workbooks(WorkbookName).Worksheets("WIP").Cells(Target.Row, ShopFloorFileCol) = "N/A"
Excel.Workbooks(WorkbookName).Worksheets("WIP").Cells(Target.Row, TestCol) = "N/A"
End If
End If
End If




' Ask if user wants to force NA in non-mechanical columns
If Target.Column = ProjMechEngCol Then
If Target.Value = "N/A" Then
If MsgBox("No CAD Engineer:" & vbCr & "Would you like to force all CAD deliverables to 'N/A'?", vbQuestion + vbYesNo + vbDefaultButton2, "No Mechanical Engineer") = vbYes Then
Excel.Workbooks(WorkbookName).Worksheets("WIP").Cells(Target.Row, GACol) = "N/A"
Excel.Workbooks(WorkbookName).Worksheets("WIP").Cells(Target.Row, SchemesCol) = "N/A"
Excel.Workbooks(WorkbookName).Worksheets("WIP").Cells(Target.Row, LoopsCol) = "N/A"
Excel.Workbooks(WorkbookName).Worksheets("WIP").Cells(Target.Row, GACol) = "N/A"
Excel.Workbooks(WorkbookName).Worksheets("WIP").Cells(Target.Row, MechDesCol) = "N/A"
End If
End If
End If




' Ask if user wants to force NA in non-software columns
If Target.Column = ProjSoftEngCol Then
If Target.Value = "N/A" Then
If MsgBox("No Software Engineer:" & vbCr & "Would you like to force all Software deliverables to 'N/A'?", vbQuestion + vbYesNo + vbDefaultButton2, "No Software Engineer") = vbYes Then
Excel.Workbooks(WorkbookName).Worksheets("WIP").Cells(Target.Row, PLCOrderCol) = "N/A"
Excel.Workbooks(WorkbookName).Worksheets("WIP").Cells(Target.Row, PLCReqCol) = "N/A"
Excel.Workbooks(WorkbookName).Worksheets("WIP").Cells(Target.Row, IntegrationCol) = "N/A"
End If
End If
End If

' Set the format based on the Status
If Target.Column = StatCol Then
SetStatusFormatting Target.Row
Target.Select

If Target.Column = StatCol Then

If UCase(Target.Text) = "COMPLETE" Or UCase(Target.Text) = "CANCELLED" Then
If MsgBox("Do you want to move this job onto the 'Completed Jobs' sheet?", vbQuestion + vbYesNo + vbDefaultButton2, "Complete Job") = vbYes Then
Excel.Workbooks(WorkbookName).Worksheets("WIP").Rows(Target.Row & ":" & Target.Row).Copy Destination:=Excel.Workbooks(WorkbookName).Worksheets("Completed Jobs").Range("A65536").End(xlUp).Offset(1, 0)
Excel.Workbooks(WorkbookName).Worksheets("WIP").Rows(Target.Row & ":" & Target.Row).Delete Shift:=xlUp
SortSheet "Completed Jobs", 2
End If
End If

If UCase(Target.Text) = "FINAL O&MS" Then
If MsgBox("Do you want to move this job onto the 'O&M to do' sheet?", vbQuestion + vbYesNo + vbDefaultButton2, "Final O&Ms") = vbYes Then
Excel.Workbooks(WorkbookName).Worksheets("WIP").Rows(Target.Row & ":" & Target.Row).Copy Destination:=Excel.Workbooks(WorkbookName).Worksheets("O&M to do").Range("A65536").End(xlUp).Offset(1, 0)
Excel.Workbooks(WorkbookName).Worksheets("WIP").Rows(Target.Row & ":" & Target.Row).Delete Shift:=xlUp
SortSheet "O&M to do", 2
End If
End If

End If
End If




' Set the format of a changed date
If Target.Rows.Count = 1 And Target.Columns.Count = 1 And Target.Row > 1 Then

' Should be a number of days late
If Target.Column >= DateStart And Target.Column <= DateEnd And UCase(Excel.Workbooks(WorkbookName).Worksheets("WIP").Cells(1, Target.Column)) = "DAYS LATE" Then
If Not IsNumeric(Target.Text) And UCase(Target.Text) <> "" Then
MsgBox "The value must be a number", vbOKOnly + vbExclamation
blnAutoOp = True
Cells(Target.Row, Target.Column) = ""
blnAutoOp = False
End If
CheckRow Target.Row
End If

' Should be a date
If Target.Column >= DateStart And Target.Column <= DateEnd And UCase(Excel.Workbooks(WorkbookName).Worksheets("WIP").Cells(1, Target.Column)) <> "DAYS LATE" Then
If (Not IsDate(Target.Text) Or InStr(1, Target.Text, ".")) And UCase(Target.Text) <> "N/A" And UCase(Target.Text) <> "" Then
MsgBox "The value must either be a Date (e.g. 10-Jun) or 'N/A'", vbOKOnly + vbExclamation
blnAutoOp = True
Cells(Target.Row, Target.Column) = ""
blnAutoOp = False
End If
CheckRow Target.Row
End If
If Target.Column = ProjSoftEngCol And Left(UCase(Excel.Workbooks(WorkbookName).Worksheets("WIP").Cells(Target.Row, 1)), 8) = "SO11299P" And Target.Text <> "ND" Then Excel.Workbooks(WorkbookName).Worksheets("WIP").Cells(Target.Row, Target.Column) = "ND"
End If
Oops:
End Sub


Public MyInitialValue
Private Sub Sub2(ByVal Target As Range)
Dim Lastrow As Long
Dim strOld As String
Dim strNew As String
Lastrow = ActiveWorkbook.Sheets("Log").Range("G1").Value
With Target(1)
strNew = .Text
Application.EnableEvents = False
Application.Undo
strOld = .Text
.Value = strNew

Application.EnableEvents = True
ActiveWorkbook.Sheets("Log").Cells(Lastrow + 2, 1) = ActiveCell.Address
ActiveWorkbook.Sheets("Log").Cells(Lastrow + 2, 2) = strOld
ActiveWorkbook.Sheets("Log").Cells(Lastrow + 2, 3) = Target.Value
ActiveWorkbook.Sheets("Log").Cells(Lastrow + 2, 4) = Application.UserName
ActiveWorkbook.Sheets("Log").Cells(Lastrow + 2, 5) = Now

'Write the Change
'ActiveWorkbook.Sheets("Log").Cells(Lastrow + 2, 1) = "WIP " & _
'ActiveCell.Address & " changed to: " & Target.Value & " - " & " Changed From: " & strOld & " - " & Application.UserName & " - " & Now
'Increase the LastRow value by 1
ActiveWorkbook.Sheets("Log").Range("G1").Value = Lastrow + 1
End With
End Sub
SamT
03-19-2018, 09:52 AM
error, "Wrong Number Of ArgumentsThe Call and the Sub Declaration

Call: Sub1 Sh, Target

Sub Declaration: Private Sub Sub1(ByVal Target As Range)
nathandavies
03-20-2018, 02:15 AM
Error " Argument not optional"

I know i'm doing something wrong somewhere i'm just not sure where.


Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)If Sh.Name = "WIP" Then 'Edit Sh.Name to suit
If Target.Column = 1 And Target.Row >= 2 Then
Call Sub1
Else
Call Sub2
End If
End If
End Sub
SamT
03-20-2018, 07:57 AM
Look at the Sub Declarations...
They have one Argument
Look at the "Calls"... They pass two Arguments

Declarations: As you have written them

Private Sub Sub1(ByVal Target As Range)
Private Sub Sub2(ByVal Target As Range)

Calls:

If Target.Column = 1 And Target.Row >= 2 Then
Sub1 Sh, Target
Else
Sub2 Sh, Target
End If
nathandavies
03-21-2018, 04:29 AM
Sorry SamT but i'm very confused now.

Ill have to have a read up on Calls & Declarations!
snb
03-21-2018, 05:22 AM
You can write Sub2 in 1 line:


Sheets("Log").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 4) = Array(sh.Target.Address(,,,-1), sh.Target.Value, Environ("UserName"), Now)

_


Writng the 'oldvalue' is redundant, because that value has been stored before, when it became the 'new value'.
nathandavies
03-21-2018, 06:34 AM
snb,

where would this fit into the code?
SamT
03-21-2018, 08:49 AM
This is a Declaration for a Sub procedure

Private Sub Sub1(ByVal Target As Range)
Not that it has one argument; Target, a Range object.

These are some Variable Declarations.

Dim X
Dim Z as Variant
Dim S As String
Dim O as Object

A Call is merely the code telling a Sub to run. The Keyword, "Call," is being deprecated by MS.

Sub Mainsub()
Call Sub 1
Sub2
End Sub
Both lines "Call" a Sub, the first explicitly Calls Sub 1. The second implicitly calls Sub2. Both lines provide the same result.

Parameters and Arguments are the same things, only in different places in the code. Parameters are the things in the parentheses in a Procedure Declaration. Functions are also Procedures. Arguments are the things one passes to a Procedure when calling or using that Procedure

Procedure Declaration with one Parameter

Private Sub Sub1(ByVal Target As Range)
Call with one argument

Sub MainSub()
Dim Rng As Range
Set Rng = ActiveSheet.Range("A1")

Call Sub1 Rng
End Sub

Sub1 code. Note that the Name of the Argument, ("Rng,") passed to Sub1 is not the Name of the Parameter, ("Target,") of the Sub.

Private Sub Sub1(ByVal Target As Range)
Dim X
X = Target.Value
End Sub

Note that passed Arguments must be in the same order as Declared Parameters, Or, must be designated with the Parameter Name.

Sub MainSub()
Dim Rng As Range
Dim Val As Long

Set Rng = ActiveSheet.Range("A1")
Val = 42

Call Sub1 Rng, Val
'OR
Sub1 Number:=Val, Target:=Rng
End Sub

Private Sub Sub1(ByVal Target As Range, Number As Long)
Target.Value = Number
End Sub
snb
03-21-2018, 08:50 AM
snb,

where would this fit into the code?

Did you read post #8 ?
nathandavies
03-21-2018, 09:53 AM
snb, yes i read the post but i'm not sure what you mean? If it can be completed with 1 line would use that one line in Worksheet_Change?
snb
03-21-2018, 10:05 AM
Yes.
nathandavies
03-23-2018, 07:17 AM
i will give it ago see what i can come up with
Paul_Hossler
03-23-2018, 01:32 PM
Q: why do you want to combine the two subs?

I'm assuming since they're both Worksheet_Change, they operate of different worksheets.

I'd seem cleaner (to me at least) to keep them seperate
nathandavies
03-26-2018, 01:45 AM
Paul,
They both operate on the same worksheet but when i had them as two separate subs they just kept coming up with an error.
Paul_Hossler
03-26-2018, 07:03 AM
OK -- you can only have one Worksheet_Change in a module

1. What is the variable 'WorkbookName' and where is it defined and set?

2. Is 'WIP' the name of the worksheet that the Worksheet_Change event handler is on?

3. Is the idea that only one cell is Changed? You can change multiple cells at one time so Target might = A1:Z26.

4. Is this a 'one workbook' application, meaning that there is only workbook being used and WIP is the only sheet that is modified?

5. If you turn off your 'On Error' what happens? It looks like if there's any error, you jump to the end.

6. Can you post a small sample workbook with the macros and correct sheets and some sample data?
nathandavies
03-27-2018, 01:47 AM
Is response to your questions Paul,
1. Workbook name is New WIP
2. worksheet Name is "WIP" this is the worksheet i want to monitor the changes in the worksheet "log"
3. only 1 cell will be changed at any one time, these are normally dates
4. correct
5. Ill test it see what happens.
6. I can post my workbook no problem, just need to take some information out of there first.
nathandavies
03-27-2018, 08:51 AM
copy of my workbook attached.
nathandavies
04-09-2018, 05:44 AM
bump?
Paul_Hossler
04-09-2018, 01:00 PM
I had looked at the attachment briefly before I left for Florida to babysit the grandkids

WS 'Lists' is missing, and I never went through the code to see if it was required





Function GetLastDate() As String
GetLastDate = Excel.Workbooks(WorkbookName).Worksheets("Lists").Cells(1, 11)
End Function
nathandavies
04-11-2018, 06:23 AM
Paul,

apologies, i have included WS "lists" in the attached workbook.
nathandavies
05-24-2018, 06:12 AM
I have tried all the different responses above and can not seem to get any to work, any further help will be greatly appreciated