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.
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.