Option Explicit
Public FoundMax As Integer ' Group maximum global variable. This is set in the GroupComboBox sub
Private Sub CancelCommandButton_Click()
Unload Me ' Closed User Form
End Sub
Function DirSelect() As String
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Select a Folder"
.AllowMultiSelect = False
.InitialFileName = Application.DefaultFilePath
If .Show <> -1 Then GoTo NextCode
sItem = .SelectedItems(1)
End With
NextCode:
DirSelect = sItem
Set fldr = Nothing
End Function
Private Sub StartCommandButton_Click()
' Should Open Table Formulas from test folder
' populate Network field & group number.
' .Value=.Value to clear arrays and keep raw text
' perform Save As .xlsx to local computer
'=====================================
' Set Variables
'=====================================
Dim wb As Workbook ' Shortcut for workbook
Dim ws As Worksheet ' Shortcut for worksheet
Dim Network As String ' Used to name workbook as part of Save As
Dim Group As String ' Used to name workbook as part of Save As
Dim sFName As String ' Used to name workbook as part of Save As - Final uniform name
Dim Def As String ' String used as part of the Save As process
Dim i As Integer ' Iterator variable
Dim Path As String ' File save path
Dim screenUpdateState As Variant
Dim statusBarState As Variant
Dim displayPagebreakState As Variant
Path = DirSelect() ' Call the function for the user to select the save path
' ============================================
' Get current state of various Excel settings.
' ============================================
screenUpdateState = Application.ScreenUpdating
statusBarState = Application.DisplayStatusBar
displayPagebreakState = ActiveSheet.DisplayPageBreaks ' This is sheet-level only.
' ==================================================
' Turn off Excel functionality to speed up the code.
' ==================================================
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
ActiveSheet.DisplayPageBreaks = False ' This is sheet-level only.
If NOOptionButton = True Then
FoundMax = 1
End If
For i = 1 To FoundMax
' Opens Tabel from ShareNow, currently hardcoded to test folder
Set wb = Workbooks.Open("https://sharenow....Table-TEST-formulas.xlsm")
'wb.Application.Visible = True ' Makes the Table spreadsheet visible
Set ws = wb.Worksheets("Table") ' Correct worksheet to activate
'ws.Visible = xlSheetVisible ' Should keep Table Formula workbook as the visible workbook and worksheet
ws.Activate ' Marks the correct workbook and worksheet to active status
ws.Range("a1").Select ' Select cell A1, safe cell with zero data.
ws.Cells(1, 3).Value = NetworkComboBox.Value ' Populate cell C1 with Network chosen from dropdown list
If NOOptionButton = True Then
ws.Cells(1, 7).Value = GroupComboBox.Value ' Populate cell G1 with group number
Else
ws.Cells(1, 7).Value = i
End If
Set wb = ActiveWorkbook ' Used as shortcut for Workbook
Set ws = wb.Worksheets("Table") ' Worksheets shortcut to read data from Table
' Read Cells(row, column).Value and store as variable - C1, Network name
Network = ws.Cells(1, 3).Value
' Read Cells(row, column).Value and store as variable - G1, Group #
Group = ws.Cells(1, 7).Value
' Final output will be in format: Table-City_Group_1.xlsx
Def = "Table-" & Network & "_Group_" & Group
Call CancelCommandButton_Click ' Close Command Button Window, seems to hang if not closed
'=====================================
' Start Copy/Paste Values only section Column D -> H, Rows 3 -> 52
'=====================================
ws.Range("D3:H52").Value2 = ws.Range("D3:H52").Value2 ' Sets the value from the array output, clearing the array formula
'=====================================
' Fill blanks null vaults with FALSE
' Leave IS/M (Row 27) blank
'=====================================
' Cells(Row, Column) -> Row 3, Column 5 -> E3
If IsEmpty(Cells(3, 5)) = True Then
ws.Range("E12:E26").Value = "FALSE"
ws.Range("E28").Value = "FALSE"
End If
' Cells(Row, Column) -> Row 3, Column 6 -> F3
If IsEmpty(Cells(3, 6)) = True Then
ws.Range("F12:F26").Value = "FALSE"
ws.Range("F28").Value = "FALSE"
End If
' Cells(Row, Column) -> Row 3, Column 7 -> G3
If IsEmpty(Cells(3, 7)) = True Then
ws.Range("G12:G26").Value = "FALSE"
ws.Range("G28").Value = "FALSE"
End If
' Cells(Row, Column) -> Row 3, Column 8 -> H3
If IsEmpty(Cells(3, 8)) = True Then
ws.Range("H12:H26").Value = "FALSE"
ws.Range("H28").Value = "FALSE"
End If
'=====================================
'Start Save As process
'=====================================
' sFName = Application.GetSaveAsFilename(InitialFileName:=Def, FileFilter:="Excel Files (*.xlsx), *.xlsx, Macro Enabled Workbook" & "(*.xlsm), *xlsm")
' If sFName <> "False" Then ' Checks that sFName has not been cancled
' If Right(sFName, 4) = "xlsx" Then ' If saved as *.xlsx this section provides correct file type 51
' Application.DisplayAlerts = False ' *.xlsx is no macros enabled
' ws.SaveAs sFName, 51
' Application.DisplayAlerts = True ' Displays all errors from SaveAs
' ElseIf Right(sFName, 4) = "xlsm" Then ' If saved as *.xlsm this section provides correct file type 52
' ws.SaveAs sFName, 52 ' *.xlsm is macro enabled
' End If
' End If
wb.SaveAs Filename:=Path & "\" & Def, CreateBackup:=False
Next i
' ===============================
' Return Excel to original state.
' ===============================
Application.ScreenUpdating = screenUpdateState
Application.DisplayStatusBar = statusBarState
ActiveSheet.DisplayPageBreaks = displayPagebreakState ' This is sheet-level only.
Unload Me
End Sub
Private Sub UserForm_Click()
On Error Resume Next
TableForm.Show
End Sub
Private Sub UserForm_Initialize()
' Create dropdown list for Network
' The use of the Me. provides auto-populate to gain access for the
' data contained in tNetworkName table with
' column header Underground Network Name
' This one line replaces the need to manually populate the list below with
' .AddItem "Network". Old code.
' <xxx 9/17/2019> Code updated to simplify future data
Me.NetworkComboBox.List = Range("tNetworkName[Network Name]").Value
' Empty group ComboBox box
GroupComboBox.Value = ""
' Set All Groups radial button default NO
NOOptionButton.Value = True
End Sub
Private Sub NetworkComboBox_Change()
Dim FoundCell As Range
Dim ws As Worksheet
Dim i As Integer
Dim rng As String
' Dim FoundMax As Integer - Now set as global variable
Set ws = ActiveSheet
GroupComboBox.Clear ' Clear current Group ComboBox
Set FoundCell = ws.Range("A:A").Find(What:=NetworkComboBox.Value) ' Find the cell for the selected network
rng = "B" & FoundCell.Row ' Build the string for the range of the max value
FoundMax = Range(rng).Value ' Assign the maximum group number
For i = 1 To FoundMax
GroupComboBox.AddItem i
Next i
End Sub
