Expand|Select|Wrap|Line Numbers
- Public Sub excel()
- Dim indx As Integer
- Dim rowIndex As Integer
- Dim colIndex As Integer
- Dim recordCount As Integer
- Dim fieldCount As Integer
- Dim MSG As String
- Dim avRows As Variant
- Dim excelVersion As Integer
- Dim transType As String
- Dim system As String
- Dim sql As String
- Dim TcrRecs()
- Dim Oput As String
- system = lstLOB.Text
- transType = lstTransacType.Text
- 'CHECK FOR SEARCH TYPE
- openconn
- If lstLOB.SelCount = 0 And lstTransacType.SelCount = 0 Then
- MsgBox "Search Requires A System/Transaction Or Both!", vbExclamation, "Error"
- closeconn
- Exit Sub
- End If
- If lstTransacType.SelCount > 0 Then
- For a = 0 To lstTransacType.ListCount - 1
- If lstTransacType.Selected(a) Then
- If sql = "" Then
- sql = " AND (TransacType = '" & lstTransacType.List(a) & "'"
- Else
- sql = sql + " or TransacType = '" & lstTransacType.List(a) & "'"
- End If
- End If
- Next
- Call rs("SELECT a.Name, b.TransacType, b.TestCaseNum, c.PolicyNum, b.TestScenarioDescription, c.Impact, c.ExpectedResults FROM Areas a, TestCases b, TestCaseExecution c WHERE a.AreaID = b.AreaID AND b.TestCaseID = c.TestCaseID " & sql & ") ORDER BY a.NAME, b.TransacType, b.TestCaseNum ASC")
- End If
- If lstLOB.SelCount > 0 And lstTransacType.SelCount = 0 Then
- For a = 0 To lstLOB.ListCount - 1
- If lstLOB.Selected(a) Then
- If sql = "" Then
- sql = " AND (name = '" & lstLOB.List(a) & "'"
- Else
- sql = sql + " or name = '" & lstLOB.List(a) & "'"
- End If
- End If
- Next
- Call rs("SELECT a.Name, b.TransacType, b.TestCaseNum, c.PolicyNum, b.TestScenarioDescription, c.Impact, c.ExpectedResults FROM Areas a, TestCases b, TestCaseExecution c WHERE a.AreaID = b.AreaID AND b.TestCaseID = c.TestCaseID " & sql & ") ORDER BY a.NAME, b.TransacType, b.TestCaseNum ASC")
- End If
- If adoRS.recordCount = 0 Then
- MsgBox "There Were No Test Cases Found Matching Your Criteria", vbInformation, "Error"
- closeconn
- Exit Sub
- End If
- 'THROWS THE RECORDSET INTO AN ARRAY
- avRows = adoRS.GetRows()
- recordCount = UBound(avRows, 2) + 1
- fieldCount = UBound(avRows, 1) + 1
- 'CREATE REDERENCE VARIABLE FOR THE SPREADSHEET
- Set objExcel = CreateObject("Excel.Application")
- objExcel.Visible = True
- objExcel.Workbooks.add
- Set objTemp = objExcel
- excelVersion = Val(objExcel.Application.Version)
- If (excelVersion >= 8) Then
- Set objExcel = objExcel.ActiveSheet
- End If
- 'PLACE THE NAMES OF THE FIELDS AS COLUMN HEADERS
- With objExcel.Cells(1, 1)
- .Value = "System"
- .VerticalAlignment = xlVAlignTop
- With .Font
- .Name = "Arial"
- .Bold = True
- .Size = 11
- .Italic = True
- End With
- End With
- With objExcel.Cells(1, 2)
- .Value = "Trans Type"
- .VerticalAlignment = xlVAlignTop
- With .Font
- .Name = "Arial"
- .Bold = True
- .Size = 11
- .Italic = True
- End With
- End With
- With objExcel.Cells(1, 3)
- .Value = "TC Nbr"
- .VerticalAlignment = xlVAlignTop
- With .Font
- .Name = "Arial"
- .Bold = True
- .Size = 11
- .Italic = True
- End With
- End With
- With objExcel.Cells(1, 4)
- .Value = "In Prog"
- .VerticalAlignment = xlVAlignTop
- With .Font
- .Name = "Arial"
- .Bold = True
- .Size = 11
- .Italic = True
- End With
- End With
- With objExcel.Cells(1, 5)
- .Value = "Req Nbr"
- .VerticalAlignment = xlVAlignTop
- With .Font
- .Name = "Arial"
- .Bold = True
- .Size = 11
- .Italic = True
- End With
- End With
- With objExcel.Cells(1, 6)
- .Value = "Policy Nbr"
- .VerticalAlignment = xlVAlignTop
- With .Font
- .Name = "Arial"
- .Bold = True
- .Size = 11
- .Italic = True
- End With
- End With
- With objExcel.Cells(1, 7)
- .Value = "Date"
- .VerticalAlignment = xlVAlignTop
- With .Font
- .Name = "Arial"
- .Bold = True
- .Size = 11
- .Italic = True
- End With
- End With
- With objExcel.Cells(1, 8)
- .Value = "Tstr Intls"
- .VerticalAlignment = xlVAlignTop
- With .Font
- .Name = "Arial"
- .Bold = True
- .Size = 11
- .Italic = True
- End With
- End With
- With objExcel.Cells(1, 9)
- .Value = "Test Scenario Description"
- .VerticalAlignment = xlVAlignTop
- With .Font
- .Name = "Arial"
- .Bold = True
- .Size = 11
- .Italic = True
- End With
- End With
- With objExcel.Cells(1, 10)
- .Value = "Impact"
- .VerticalAlignment = xlVAlignTop
- With .Font
- .Name = "Arial"
- .Bold = True
- .Size = 11
- .Italic = True
- End With
- End With
- With objExcel.Cells(1, 11)
- .Value = "Expected Results"
- .VerticalAlignment = xlVAlignTop
- With .Font
- .Name = "Arial"
- .Bold = True
- .Size = 11
- .Italic = True
- End With
- End With
- 'MEMORY MANAGEMENT
- adoRS.Close
- Set adoRS = Nothing
- 'ADD THE DATA
- With objExcel
- For rowIndex = 2 To recordCount + 1
- Oput = IIf(IsNull(avRows(1 - 1, rowIndex - 2)), "", avRows(1 - 1, rowIndex - 2))
- 'Oput = avRows(1 - 1, rowIndex - 2)
- Oput = Replace(Oput, Chr(13), "")
- Oput = Replace(Oput, Chr(9), "")
- .Cells(rowIndex, 1).Value = Oput
- ' .Cells(rowIndex, 1).Value = avRows _
- ' (1 - 1, rowIndex - 2)
- Oput = IIf(IsNull(avRows(2 - 1, rowIndex - 2)), "", avRows(2 - 1, rowIndex - 2))
- 'Oput = avRows(2 - 1, rowIndex - 2)
- Oput = Replace(Oput, Chr(13), "")
- Oput = Replace(Oput, Chr(9), "")
- .Cells(rowIndex, 2).Value = Oput
- ' .Cells(rowIndex, 2).Value = avRows _
- ' (2 - 1, rowIndex - 2)
- Oput = IIf(IsNull(avRows(3 - 1, rowIndex - 2)), "", avRows(3 - 1, rowIndex - 2))
- 'Oput = avRows(3 - 1, rowIndex - 2)
- Oput = Replace(Oput, Chr(13), "")
- Oput = Replace(Oput, Chr(9), "")
- .Cells(rowIndex, 3).Value = Oput
- ' .Cells(rowIndex, 3).Value = avRows _
- ' (3 - 1, rowIndex - 2)
- .Cells(rowIndex, 4).Value = " "
- .Cells(rowIndex, 5).Value = " "
- Oput = IIf(IsNull(avRows(4 - 1, rowIndex - 2)), "", avRows(4 - 1, rowIndex - 2))
- 'Oput = avRows(4 - 1, rowIndex - 2)
- Oput = Replace(Oput, Chr(13), "")
- Oput = Replace(Oput, Chr(9), "")
- .Cells(rowIndex, 6).Value = Oput
- ' .Cells(rowIndex, 6).Value = avRows _
- ' (4 - 1, rowIndex - 2)
- .Cells(rowIndex, 7).Value = " "
- .Cells(rowIndex, 8).Value = " "
- Oput = IIf(IsNull(avRows(5 - 1, rowIndex - 2)), "", avRows(5 - 1, rowIndex - 2))
- 'Oput = avRows(5 - 1, rowIndex - 2)
- Oput = Replace(Oput, Chr(13), "")
- Oput = Replace(Oput, Chr(9), "")
- .Cells(rowIndex, 9).Value = Oput
- ' .Cells(rowIndex, 9).Value = avRows _
- ' (5 - 1, rowIndex - 2)
- Oput = IIf(IsNull(avRows(6 - 1, rowIndex - 2)), "", avRows(6 - 1, rowIndex - 2))
- 'Oput = avRows(6 - 1, rowIndex - 2)
- Oput = Replace(Oput, Chr(13), "")
- Oput = Replace(Oput, Chr(9), "")
- .Cells(rowIndex, 10).Value = Oput
- ' .Cells(rowIndex, 10).Value = avRows _
- ' (6 - 1, rowIndex - 2)
- Oput = avRows(7 - 1, rowIndex - 2)
- Oput = Replace(Oput, Chr(13), "")
- Oput = Replace(Oput, Chr(9), "")
- .Cells(rowIndex, 11).Value = Oput
- ' .Cells(rowIndex, 11).Value = avRows _
- ' (7 - 1, rowIndex - 2)
- Next
- End With
- objExcel.Cells(1, 1).CurrentRegion.EntireColumn.AutoFit
- objExcel.Cells(1, 1).CurrentRegion.VerticalAlignment = xlVAlignTop
- objExcel.Cells(1, 1).CurrentRegion.WrapText = True
- ' This what I added*******************************************************
- Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Key2:=Range("C1") _
- , Order2:=xlAscending, Key3:=Range("B1"), Order3:=xlAscending, Header:= _
- xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
- '*************************************************************************
- closeconn
- End Sub