I have a procedure I am writing which is to ask the user some questions and then via the OpenFile dialog open a another workbook and perform some calculations the insert those calculations into the first workbook(Workbook1). Wokrbook1 has three spreadsheets in it which are exactly alike. My code below for reference but as is the code change the active sheet but all values are inserted to the first not any of the others. How can I set the sheet references to loop through the sheets after the SUMIFS are performed and insert the values in the right spot?
Code:
Private Sub btnCalculateTotals_Click()
'===============================================================================================
'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 = False
Set ToWorkbook = ActiveWorkbook
Set ToWorksheet = ToWorkbook.ActiveSheet
LastRow = ToWorksheet.Range("Y:Y").Find( _
What:="*", _
After:=ToWorksheet.Range("Y1"), _
LookAt:=xlPart, _
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)
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
WholeRange.Columns(AssetCountColNum).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
Set ToWorksheet = ToWorkbook.Worksheets(OwnerSelected)
ToWorksheet.Activate
Set WorkingRange = ToWorksheet.Range("B" & StartRow & ":G" & StartRow + 38)
Debug.Print WorkingRange.Address
Set SystemCol = WorkingRange.Columns(2)
Debug.Print SystemCol.Address
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
SystemName.Offset(0, 1).Value2 = CATI
Debug.Print SystemName.Address
SystemName.Offset(0, 2).Value2 = CATII
SystemName.Offset(0, 3).Value2 = CATIII
SystemName.Offset(0, 4).Value2 = 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
Owners() = Split( _
Expression:="Site,System,Investigation Req'd", _
Delimiter:=",", _
Limit:=-1, _
Compare:=vbBinaryCompare)
For Each Owner In Owners()
OwnerSelected = Owner
Debug.Print OwnerSelected
Set ToWorksheet = ToWorkbook.Worksheets(OwnerSelected)
ToWorksheet.Activate
Set WorkingRange = ToWorksheet.Range("B" & StartRow & ":G" & StartRow + 38)
Debug.Print WorkingRange.Address
Set SystemCol = WorkingRange.Columns(2)
Debug.Print SystemCol.Address
SystemName.Offset(0, 1).Value2 = CATI
Debug.Print
SystemName.Offset(0, 2).Value2 = CATII
SystemName.Offset(0, 3).Value2 = CATIII
SystemName.Offset(0, 4).Value2 = CATIV
Next Owner
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
