OK, for anyone who is interested, here is the code for the AddTest macro. It
calls some other macros, and makes some assumptions about the worksheet it is
called from, but I think it should be fairly clear.
Sub AddTest()
'Description:
' Get the Test Case ID from the top of the worksheet, remove any white space
' and convert to upper case. Determine which section the selected permuta-
' tions are in and choose corresponding test type code. Read the
NumberFormat
' property for the entire selection and adjust for special cases. Call
' AddSingle on each cell in the selection to create the test name in the
' target cell.
'Parameters: (none)
'Global Variables:
' xlTarget - the cell chosen to contain the next test case name
'Notes:
' Macro assumes that all selected cells are permutation numbers, but it
' only looks at the first column of an array, so it is fairly insensitive to
' users selecting entire rows or including cells to the right of permutation
' numbers.
' Excel 2003 throws an error when it sees the value parameter being ac-
' cessed as an array regardless of whether that code will be executed, so
the
' value2 property is used for those instances.
'Keyboard Shortcut: Ctrl+m
'Local Variables:
' SKY_BLUE - Color value used for test section titles
Const SKY_BLUE = 33
' iAnswer - Result of MsgBox call
Dim iAnswer As Integer
' strTcId - String to hold the TC ID from the worksheet
Dim strTcId As String
' bSectionFound - Flag for test section identified
Dim bSectionFound As Boolean
' strTestType - String to hold the test type code (P, N or E)
Dim strTestType As String
' xlSectionName - Cell that looks like a type section title
Dim xlSectionName As Excel.Range
' xlSearchStart - Cell from which to begin searching
Dim xlSearchStart As Excel.Range
' strError - Error information
Dim strError As String
' xlPnumRange - The selection of permutation numbers
Dim xlPnumRange As Excel.Range
' strFormatSpec - NumberFormat specification
Dim strFormatSpec As String
' strPnum - Permutation number as text
Dim strPnum As String
' xlCurrRange - Range object pulled from Areas collection (noncontiguous
' selection)
Dim xlCurrRange As Excel.Range
' lPnumIndex - index into array of permutation cell values
Dim lPnumIndex As Long
'If target cell has not been identified
If bTargetDefined = False Then
iAnswer = MsgBox("No destination is selected", vbExclamation,
"AddTest")
Exit Sub
Else
'GET THE TC ID - remove white space
strTcId = Trim(CleanText(Cells(1, 3).Value, bReplace:=False))
'Convert to upper case
strTcId = UCase(strTcId)
'Add underscore if not already present
If Right(strTcId, 1) < "_" Then
strTcId = strTcId & "_"
End If
'IDENTIFY SECTION
'Initialize section found flag
bSectionFound = False
'Start search for section name at cell to the right one and up one
from
'the first cell of the selected permutation(s)
Set xlSearchStart = Selection.Cells(1, 1).Offset(-1, 1)
Do While bSectionFound = False
'Search upwards for test group banner
Set xlSectionName = Cells.Find(What:=" Tests",
After:=xlSearchStart, _
LookIn:=xlValues, LookAt:=xlPart,
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, MatchCase:=False)
'If search failed
If xlSectionName Is Nothing Then
'Find section failure - indicate with message box and exit
iAnswer = MsgBox("Couldn't find test type title",
vbExclamation, _
"AddTest")
Exit Sub
Else
'(found possible banner text)
'If section name cell is not above permutation cell
If Selection.Row <= xlSectionName.Row Then
'Find section failed - indicate with message box and exit
strError = "Couldn't find test type title" & vbCr & _
"above selected permutation number(s)"
iAnswer = MsgBox(strError, vbExclamation, "AddTest")
Exit Sub
'If above permutation cell but wrong color
ElseIf xlSectionName.Interior.ColorIndex < SKY_BLUE Then
'Search for next match
Set xlSearchStart = xlSectionName
'If it contains "Positive Tests"
ElseIf StrComp(xlSectionName.Value, "Positive Tests", _
vbBinaryCompare) = 0 Then
'Add code "P" and end search
strTestType = "P"
bSectionFound = True
'If it contains "Negative Tests"
ElseIf StrComp(xlSectionName.Value, "Negative Tests", _
vbBinaryCompare) = 0 Then
'Add code "N" and end search
strTestType = "N"
bSectionFound = True
'If it contains "Error Recovery Tests"
ElseIf StrComp(xlSectionName.Value, "Error Recovery Tests", _
vbBinaryCompare) = 0 Then
'Add code "E" and end search
strTestType = "E"
bSectionFound = True
Else '(unrecognized section name)
'indicate with message box and exit
strError = "Found invalid test type title" & vbCr & "'"
& _
xlSectionName.Value & "'"
iAnswer = MsgBox(strError, vbExclamation, "AddTest")
Exit Sub
End If
End If
Loop
'Get selected cells
Set xlPnumRange = Selection
'If single cell selected
If xlPnumRange.Count < 2 Then
'Get good format spec
strFormatSpec = AdjustFormat(xlPnumRange)
'Make next name with this permutation
Call AddSingle(xlPnumRange.Value, strFormatSpec, strTcId &
strTestType)
'Else if noncontiguous selection
ElseIf 1 < xlPnumRange.Areas.Count Then
For Each xlCurrRange In xlPnumRange.Areas
'Get good format spec
strFormatSpec = AdjustFormat(xlCurrRange)
'If this range is a single cell
If xlCurrRange.Count < 2 Then
'Make next name with this permutation
Call AddSingle(xlCurrRange.Value, strFormatSpec, strTcId
& _
strTestType)
'Else if range is a contiguous group
ElseIf IsArray(xlCurrRange.Value) Then
For lPnumIndex = LBound(xlCurrRange.Value, 1) To _
UBound(xlCurrRange.Value, 1)
'Make next name with this permutation
Call AddSingle(xlCurrRange.Value2(lPnumIndex, 1), _
strFormatSpec, strTcId & strTestType)
Next lPnumIndex
End If
Next xlCurrRange
'Else if selection is a contiguous group
ElseIf IsArray(xlPnumRange.Value) Then
'Get good format spec
strFormatSpec = AdjustFormat(xlPnumRange)
'For each row in value array
For lPnumIndex = LBound(xlPnumRange.Value, 1) To _
UBound(xlPnumRange.Value, 1)
'Make next name with this permutation
Call AddSingle(xlPnumRange.Value2(lPnumIndex, 1),
strFormatSpec, _
strTcId & strTestType)
Next lPnumIndex
End If
'END if target cell defined (else clause)
End If
End Sub
"keepITcool" wrote:
post your code, so we may (dis)agree or advise
--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam