I have a workbook with multiple tables as depicted in the following image:
I am trying to write a procedure to loop through the list of system names and ask the user a series of questions.
First asks the user:
Are there scan files to read?
It then asks the user:
Is there a scan file for the system: SystemName?
If the user selects yes, then Excel then opens a file selected by the user. Although the first system that has a file get skipped for some reason and the second one fails due to the Run-time error '1004': Application-defined or object-defined error. Not sure why it is not getting opened.
If the user selects no, then Excel asks if there is Information Assurance Vulnerabilities for the system: SystemName?
If there is not IAVs then Excel place 0 for each CATI, II, III, IV column.
It there is IAVS then I Excel should re-ask to open the file.
Below is the code for the procedure:
I am trying to write a procedure to loop through the list of system names and ask the user a series of questions.
First asks the user:
Are there scan files to read?
It then asks the user:
Is there a scan file for the system: SystemName?
If the user selects yes, then Excel then opens a file selected by the user. Although the first system that has a file get skipped for some reason and the second one fails due to the Run-time error '1004': Application-defined or object-defined error. Not sure why it is not getting opened.
If the user selects no, then Excel asks if there is Information Assurance Vulnerabilities for the system: SystemName?
If there is not IAVs then Excel place 0 for each CATI, II, III, IV column.
It there is IAVS then I Excel should re-ask to open the file.
Below is the code for the procedure:
Code:
Sub TestCode()
'===============================================================================================
'Description: Loops through the selected site and adds in the vulnerability totals for each _
systems
'Originally written by: Troy Pilewski
'Date: 2016-06-30
'===============================================================================================
'Declares variables
Dim ToWorkbook As Workbook, FromWorkbook As Workbook
Dim ToWorksheet As Worksheet, FromWorksheet As Worksheet
Dim WorkingRange As Range, WholeRange As Range, SystemCol As Range, SystemName As Range, _
DataRange As Range, OwnerCol As Range, CategoryCol As Range, AssetCountCol As Range
Dim VarFromWorkbook As Variant, ShipNameList() As Variant, ShipName As Variant, Owner As Variant
Dim TitleString As String, FilterName As String, CurrentSystemName As String, _
ShipNames() As String, SelectedShipName As String, Owners() As String, OwnerSelected As String
Dim LastRow As Long, ShipRow As Long, OwnerColNum As Long, CategoryColNum As Long, _
AssetCountColNum As Long
Dim StartRow As Integer, BoundCounter As Integer, MsgSelection As Integer, _
ScanFileExist As Integer, CATI As Integer, CATII As Integer, CATIII As Integer, _
CATIV As Integer
Const RowMultiplyer As Integer = 47
'-----------------------------------------------------------------------------------------------
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Set ToWorkbook = ActiveWorkbook
Set ToWorksheet = ToWorkbook.ActiveSheet
LastRow = ToWorksheet.Range("Y:Y").Find( _
What:="*", _
After:=ToWorksheet.Range("Y1"), _
LookAt:=xlByRows, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious _
).Row
'MsgBox _
' Prompt:="Y1:Y" & LastRow, _
' Title:="Ship Range"
ShipNameList = ToWorksheet.Range("Y1:Y" & LastRow).Value
For Each ShipName In ShipNameList
If Left(ShipName, 3) = "USS" Then
BoundCounter = BoundCounter + 1
End If
Next ShipName
ReDim ShipNames(BoundCounter - 1)
BoundCounter = 0
For Each ShipName In ShipNameList
If Left(ShipName, 3) = "USS" Then
ShipNames(BoundCounter) = ShipName
' Debug.Print ShipNames(BoundCounter)
BoundCounter = BoundCounter + 1
Else
' Debug.Print UBound(ShipNames())
Exit For
End If
Next ShipName
TitleString = "Select a ship..."
SelectedShipName = GetChoiceFromChooserForm(ShipNames, TitleString)
If SelectedShipName = "" Then
Exit Sub
End If
ShipRow = ToWorksheet.Range("Y:Y").Find( _
What:=SelectedShipName, _
After:=ToWorksheet.Range("Y1"), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=True _
).Row
'Debug.Print ShipRow
StartRow = 14
If ShipRow > 1 Then
StartRow = (RowMultiplyer * (ShipRow - 1)) + StartRow
Else
StartRow = 14
End If
Set WorkingRange = ToWorksheet.Range("B" & StartRow & ":G" & StartRow + 38)
Set SystemCol = WorkingRange.Columns(2)
'Debug.Print WorkingRange.Address
FilterName = "Excel Files (*.xls), *.xls,Excel Files (*.xlsx), *.xlsx,All Files (*.*), *.*"
TitleString = "Scan File Selection"
ScanFileExist = MsgBox( _
Prompt:="Are there scan files to read?", _
Buttons:=vbYesNo, _
Title:=TitleString)
Do While ScanFileExist = vbYes
For Each SystemName In SystemCol.Cells
If IsError(SystemName) Then
Exit For
Else
If SystemName.Offset(0, -1) > 1 Then
MsgBox _
Prompt:=SystemName & " is marked 'Do Not Scan'", _
Title:="Do Not Scan"
GoTo NextIteration
Else
MsgSelection = MsgBox( _
Prompt:="Is there a scan file for the system: " & SystemName & "?", _
Buttons:=vbYesNo, _
Title:=TitleString)
CATI = 0
CATII = 0
CATIII = 0
CATIV = 0
If MsgSelection = vbYes Then
VarFromWorkbook = Application.GetOpenFilename( _
FileFilter:=FilterName, _
FilterIndex:=2, _
Title:=TitleString)
On Error GoTo NextIteration
Set FromWorkbook = Workbooks.Open( _
Filename:=VarFromWorkbook, _
UpdateLinks:=xlUpdateLinksNever, _
ReadOnly:=False, _
Format:=5, _
Password:="", _
WriteResPassword:="", _
IgnoreReadOnlyRecommended:="", _
Origin:="", _
Delimiter:="", _
Editable:="", _
Notify:="", _
Converter:="", _
AddToMru:="", _
Local:="", _
CorruptLoad:=xlNormalLoad)
Set FromWorksheet = FromWorkbook.Worksheets(1)
With FromWorksheet
LastRow = .Range("A:J").Find( _
What:="*", _
After:=.Range("A1"), _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious _
).Row
Set WholeRange = .Range("A2:J" & LastRow)
Set DataRange = .Range("A3:J" & LastRow)
OwnerColNum = .Range("A:J").Find( _
What:="Owner", _
After:=.Range("A1"), _
LookAt:=xlPart, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext _
).Column
CategoryColNum = .Range("A:J").Find( _
What:="CAT", _
After:=.Range("A1"), _
LookAt:=xlPart, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext _
).Column
AssetCountColNum = .Range("A:J").Find( _
What:="Not Compliant", _
After:=.Range("A1"), _
LookAt:=xlPart, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext _
).Column
DataRange.Columns(AssetCountCol).Replace _
What:="(****%)", _
Replacement:=" ", _
LookAt:=xlPart, _
SearchOrder:=xlByColumns, _
MatchCase:=False, _
SearchFormat:=False, _
ReplaceFormat:=False
Owners() = Split( _
Expression:="Site,System,Investigation Req'd", _
Delimiter:=",", _
Limit:=-1, _
Compare:=vbBinaryCompare)
With WholeRange
Set OwnerCol = .Columns(OwnerColNum)
Set CategoryCol = .Columns(CategoryColNum)
Set AssetCountCol = .Columns(AssetCountColNum)
For Each Owner In Owners()
OwnerSelected = Owner
Debug.Print OwnerSelected
With WorksheetFunction
CATI = .SumIfs( _
Arg1:=AssetCountCol, _
Arg2:=OwnerCol, _
Arg3:=Owner, _
Arg4:=CategoryCol, _
Arg5:="I")
CATII = .SumIfs( _
Arg1:=AssetCountCol, _
Arg2:=OwnerCol, _
Arg3:=Owner, _
Arg4:=CategoryCol, _
Arg5:="II")
CATIII = .SumIfs( _
Arg1:=AssetCountCol, _
Arg2:=OwnerCol, _
Arg3:=Owner, _
Arg4:=CategoryCol, _
Arg5:="III")
CATIV = .SumIfs( _
Arg1:=AssetCountCol, _
Arg2:=OwnerCol, _
Arg3:=Owner, _
Arg4:=CategoryCol, _
Arg5:="IV")
End With
Debug.Print CATI
Debug.Print CATII
Debug.Print CATIII
Debug.Print CATIV
Next Owner
End With
End With
If VarFromWorkbook = "False" Then
End If
Else: MsgSelection = vbNo
MsgSelection = MsgBox( _
Prompt:="Is there Information Assurance Vulnerabilities for the system: " & SystemName & "?", _
Buttons:=vbYesNo, _
Title:=TitleString)
If MsgSelection = vbYes Then
VarFromWorkbook = Application.GetOpenFilename( _
FileFilter:=FilterName, _
FilterIndex:=2, _
Title:=TitleString)
Else: MsgSelection = vbNo
SystemName.Offset(0, 1).Value2 = CATI
SystemName.Offset(0, 2).Value2 = CATII
SystemName.Offset(0, 3).Value2 = CATIII
SystemName.Offset(0, 4).Value2 = CATIV
End If
End If
End If
End If
NextIteration:
Next SystemName
ScanFileExist = MsgBox( _
Prompt:="Are there any other scan files to read?", _
Buttons:=vbYesNo, _
Title:=TitleString)
Loop
End Sub
Last edited: