I am working on a macro in excel and I am almost done, just one last thing keeps bothering me, and I would like to add it before putting it in use, as sort of a safeguard/control mechanism.
The code ought to take the data on one sheet, analyse which rows belong to specific dynamically defined variable (of one of the rows) and create separate password protected xlsx files as a result.
The thing that bothers me is that I can not make the ELSE statement append the information to the resulting output, instead it overwrites it.
The code goes as follows:
Option Explicit
'Split data into separate PWD protected XLSX files based on a set variable in second sheet.
Sub SplitData()
Dim WB As Workbook
Dim p As Range
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.DisplayAlerts = False
For Each p In Sheets("Support").Range("Variable")
If p.Value = 1 Then
Workbooks.Add
Set WB = ActiveWorkbook
ThisWorkbook.Activate
WriteToWorkbook WB, p.Value
WB.SaveAs ThisWorkbook.Path & "\Test_" & "WTF" & p.Value, xlWorkbookDefault, 123
WB.Close
ElseIf p.Value = 2 Then
Workbooks.Add
Set WB = ActiveWorkbook
ThisWorkbook.Activate
WriteToWorkbook WB, p.Value
WB.SaveAs ThisWorkbook.Path & "\Test_" & "WTF" & p.Value, xlWorkbookDefault, 234
WB.Close
ElseIf p.Value = 3 Then
Workbooks.Add
Set WB = ActiveWorkbook
ThisWorkbook.Activate
WriteToWorkbook WB, p.Value
WB.SaveAs ThisWorkbook.Path & "\Test_" & "WTF" & p.Value, xlWorkbookDefault, 345
WB.Close
ElseIf p.Value = 4 Then
Workbooks.Add
Set WB = ActiveWorkbook
ThisWorkbook.Activate
WriteToWorkbook WB, p.Value
WB.SaveAs ThisWorkbook.Path & "\Test_" & "WTF" & p.Value, xlWorkbookDefault, 456
WB.Close
ElseIf p.Value = 5 Then
Workbooks.Add
Set WB = ActiveWorkbook
ThisWorkbook.Activate
WriteToWorkbook WB, p.Value
WB.SaveAs ThisWorkbook.Path & "\Test_" & "WTF" & p.Value, xlWorkbookDefault, 567
WB.Close
Else
Workbooks.Add
Set WB = ActiveWorkbook
ThisWorkbook.Activate
WriteToWorkbook WB, p.Value
WB.SaveAs ThisWorkbook.Path & "\Test_" & "WTF", xlWorkbookDefault, 147
WB.Close
End If
Next p
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.DisplayAlerts = True
Set WB = Nothing
End Sub
'Writes all the data in rows belonging to specific Variable to the first sheet in the named WB.
Sub WriteToWorkbook(ByVal WB As Workbook, _
ByVal Variable As String)
Dim rw As Range
Dim VariableRows As Range 'Stores all of the rows found containing the searched Variable
For Each rw In UsedRange.Rows
If Variable = rw.Cells(1, 4) Then 'Defines which column is to be controlled (rows, cells)
If VariableRows Is Nothing Then
Set VariableRows = rw
Else
Set VariableRows = Union(VariableRows, rw)
End If
End If
Next rw
VariableRows.Copy WB.Sheets(1).Cells(Rows.Count, 4).End(xlUp).Offset(1, 0)
Set VariableRows = Nothing
End Sub
Any and all help is appreciated.
Big thanks and credits go to https://superuser.com/users/10554/daveparillo whos initial script I adapted to suit my needs - https://superuser.com/questions/57157/can-i-split-a-spreadsheet-into-multiple-files-based-on-a-column-in-excel-2007
Also if someone has any ideas to increase the efficiency of the script (it will go over 10k+ rows and split them into 50+ new tables).
Thank you in advance.