Sub Worksheet_Change(ByVal Target As Range)
'/////////////////////////
'//str for string
'//rng for range
'//lng for long
'//int for integer
'//sgl for single
'//dbl for double
'//bln for boolean
'//byt for byte
'/////////////////////////
Dim strInBk As String '//name of input workbook
Dim strOutBk As String '//name of output workbook
Dim strInSht As String '//name of input sheet
Dim strOutSht As String '//name of output sheet
Dim intInRowTarget As Integer '//intInRow target
Dim rngInCellTarget As Range '//rngInCell target
Dim blnReVal As Boolean '//re-evaluation in progress true/false
Dim blnUnit As Boolean '//re-evaluation due to unit change true/false
Dim intActiveSel As Integer '//rows in active selection range
'/////////////////////////
'//Set Variables:
blnReVal = False
blnUnit = False
strInBk = "Book3.xls"
strOutBk = "Book3.xls"
strInSht = "INPUT"
strOutSht = "TEST"
intActiveSel = Selection.Rows.Count
'////****On Error****////
On Error GoTo worksheetErrHandler
'/////////////////////////
If Target.Address = "$H$2" Then
blnUnit = True
GoTo unitChange
ElseIf intActiveSel > 1 Then
GoTo reEvaluate
ElseIf Target.Column <= Columns("I").Column And Target.Row > 2 Then
intInRowTarget = funInRowTarget(Target)
Set rngInCellTarget = funInCellTarget(Target)
blnReVal = False
GoTo inputChange
End If
'/////////////////////////
'////***inputChange***////
inputChange:
'/////////////////////////
Dim rngInCell As Range '//starting cell on input sheet
Dim rngInRow As Range '//starting row on input sheet
Dim intInRow As Integer '//row number of the active cell on input sheet
Dim rngOutRow As Range '//starting row on output sheet
Dim intOutRow As Integer '//row number of the active cell on output sheet
Dim rngOutCell As Range '//starting cell on output sheet
Dim dblInItem As Double '//item number from input sheet
Dim dblOutItem As Double '//item number to output sheet
Dim strOutItem As String '//item number to output sheet in string format
Dim strOutDesc As String '//description from function to output sheet
Dim strInMethod As String '//data from method field on input sheet
Dim strOutMethod As String '//data to method field on output sheet
Dim strInZone As String '//data from zone field on input sheet
Dim strOutZone As String '//data to method field on output sheet
'/////////////////////////
Application.ScreenUpdating = False
'//Set Working Row:
intInRow = intInRowTarget
Set rngInCell = rngInCellTarget
Set rngInRow = Rows(intInRow)
Set rngInCell = Range("I" & rngInRow.Row)
'//Get Input Variables:
dblInItem = rngInCell.Offset(0, -8).Value
strInMethod = rngInCell.Offset(0, -3).Value
strInZone = rngInCell.Offset(0, -2).Value
'//Set Output Variables:
dblOutItem = dblInItem
strOutItem = dblOutItem
If strOutItem = 0 Then strOutItem = ""
strOutDesc = funDescription(intInRow, rngInCell)
strOutMethod = strInMethod
strOutZone = strInZone
'//Set Output Range:
intOutRow = intInRow + 5
Set rngOutRow = Rows(intOutRow)
'//Output Data to Output Sheet:
Sheets(strOutSht).Range("A" & rngOutRow.Row).Value = strOutItem
Sheets(strOutSht).Range("B" & rngOutRow.Row).Value = strOutDesc
Sheets(strOutSht).Range("C" & rngOutRow.Row).Value = strOutMethod
Sheets(strOutSht).Range("D" & rngOutRow.Row).Value = strOutZone
'/////////////////////////
'//Exit:
If blnReVal = False Then
GoTo worksheetExitHandler
Else
GoTo contReval
End If
'/////////////////////////
'////***unitChange***////
unitChange:
'/////////////////////////
Dim intReply As Integer
Dim blnChoice As Boolean
'/////////////////////////
If Target.Value = "" Then blnChoice = False Else blnChoice = True
'/////////////////////////
If blnChoice = False Then
intReply = MsgBox(prompt:="STANDARD units have been selected." & Chr(13) & "Would you like your project, " & strInBk & ", to reflect this change?", _
Buttons:=vbYesNoCancel, Title:="PROJECT UNITS CHANGE")
'/////////////////////////
Else
intReply = MsgBox(prompt:="METRIC units have been selected." & Chr(13) & "Would you like your project, " & strInBk & ", to reflect this change?", _
Buttons:=vbYesNoCancel, Title:="PROJECT UNITS CHANGE")
'/////////////////////////
End If
'/////////////////////////
If intReply = vbYes Then
GoTo reEvaluate
'/////////////////////////
ElseIf intReply = vbNo Then
Sheets(strInSht).Select
Sheets(strInSht).Range("H2").Select
GoTo worksheetExitHandler
'/////////////////////////
Else
Sheets(strInSht).Select
Sheets(strInSht).Range("H2").Select
GoTo worksheetExitHandler
'/////////////////////////
End If
'/////////////////////////
'////***reEvaluate***////
reEvaluate:
'/////////////////////////
Application.EnableEvents = True
'/////////////////////////
Dim rngInTarget As Range '//target range of input sheet
Dim rngOutTarget As Range '//target range of output sheet
Dim strInRange As String '//usable range of input sheet
Dim strOutRange As String '//usable range of output sheet
Dim rngInRange As Range '//usable range of input sheet
Dim rngOutRange As Range '//usable range of output sheet
Dim rngInLine As Range '//working line on input sheet
Dim rngOutLine As Range '//working line on output sheet
Dim intInLine As Integer '//number of working line on input sheet
Dim intInLast As Integer '//last line of rngInRange
'/////////////////////////
Application.ScreenUpdating = False
'/////////////////////////
'//Set Variables:
blnReVal = True
Set rngInRange = Workbooks(strInBk).Sheets(strInSht).Range("A3:AA65536")
Set rngOutRange = Workbooks(strOutBk).Sheets(strOutSht).Range("A8:AA65536")
'/////////////////////////
'//Clear Output Sheet of Current Data:
Workbooks(strOutBk).Sheets(strOutSht).Select
If blnUnit = True Then
Set rngOutTarget = Intersect(funTrueUsedRange, rngOutRange)
If (Not rngOutTarget Is Nothing) Then
rngOutTarget.Select
rngOutTarget.ClearContents
End If
End If
'/////////////////////////
'//Set Range to Evaluate on Input Sheet:
Workbooks(strInBk).Sheets(strInSht).Select
If blnUnit = True Then
Set rngInTarget = Intersect(funTrueUsedRange, rngInRange)
Else
Set rngInTarget = Selection
End If
rngInTarget.Select
'//Find Last Row:
intInLast = rngInTarget.Rows.Count
'/////////////////////////
'//For Each Line:
For Each rngInLine In rngInTarget
intInLine = intInLine + 1
intInRowTarget = funInRowTarget(ActiveCell)
Set rngInCellTarget = funInCellTarget(ActiveCell)
If intInLine > intInLast Then
If blnUnit = True Then MsgBox ("Unit conversion complete")
GoTo worksheetExitHandler
End If
GoTo inputChange
'////***contReval***////
contReval:
ActiveCell.Offset(1, 0).Select
Next rngInLine
'/////////////////////////
'//Select H2 and Exit:
If blnUnit = True Then
Sheets(strInSht).Select
Sheets(strInSht).Range("H2").Select
End If
GoTo worksheetExitHandler
'/////////////////////////
'////***ErrHandler***////
worksheetErrHandler:
Dim rngFieldName As Range
Dim strFieldName As String
Set rngFieldName = Intersect(Target.Columns.EntireColumn, Range("A1").Rows.EntireRow)
strFieldName = rngFieldName.Value
If Err.Number = 13 Then
MsgBox "Incorrect data format for field: ''" & strFieldName & "''", Title:="DATA FORMAT ERROR"
ElseIf Err.Number = 1004 Then
GoTo worksheetExitHandler
Else
MsgBox "An error occurred" & Chr(13) & "Error Number:" & Chr(13) & Err.Number, Title:="ERROR: " & Err.Number
End If
GoTo worksheetExitHandler
'/////////////////////////
'////***ExitHandler***////
worksheetExitHandler:
Application.ScreenUpdating = True
Application.EnableEvents = True
Exit Sub
'/////////////////////////
'////***End Sub****////
End Sub
