1

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.

  • Thank you for your question Marek, could you please elaborate on: "make the ELSE statement append the information to the resulting output, instead it overwrites it" Does it overwrite the newly created workbook when it encounters the second row that triggers the `Else` statement? – Luuklag May 03 '18 at 11:19
  • Hi there, indeed, it overwrites the file with the results of the new variable...take it as numbers...the `Else` statement writes everything with the number 6 into the file, when it closes the workbook it takes on the next number in line (7) and overwrites the file, even though I am trying to make it start copying to last row with information+1 with the `VariableRows.Copy WB.Sheets(1).Cells(Rows.Count, 4).End(xlUp).Offset(1, 0)` – Marek Benus May 03 '18 at 11:24
  • `Rows.count` might not be the best way to do this. You are better of using the `LastRow` principle. Try to search for that and implement that. Also I see a lot of workbook activation taking place, that is something that is prone to errors as well, you should read up on how to avoid select for example: https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba – Luuklag May 03 '18 at 11:38
  • I'm surprised `For Each rw In UsedRange.Rows` works as UsedRange is a property of a worksheet, which is not being specified here. – SJR May 03 '18 at 11:38
  • @SJR I bet it just defaults to the active worksheet, which could be any sheet ofcourse. – Luuklag May 03 '18 at 11:39
  • @Luuklag - yes I had the same thought. Not sure if it that could be the problem but I think should be rectified anyway. – SJR May 03 '18 at 11:41
  • Thank for the tip, I will take a look at it. I have not found any other suitable way of iterating and saving differing files with differing passwords, thus I took the workbook activation route. It is slow and I expect to come to errors when the amount of data will increase, but as it was the only option I had come up with, it was the route I took. I am open to suggestions to improve the script in any way :) – Marek Benus May 03 '18 at 11:45
  • I'd change the `WB` variables you have in your current code to a single variable for each different WorkBook, so perhaps `WB1`, `WB2` etc. Then explicitly reference those workbooks by setting `WB1`to `ThisWorkbook.Path & "\Test_" & "WTF1"` – Luuklag May 03 '18 at 12:06
  • @Luuklag The `Else` should be there if the macro will encounter some variable, that wil not have a specific number set, and save them all into the "others" file...this alteration would not resolve the issue I am facing (as far as I know) – Marek Benus May 03 '18 at 12:11
  • The `WB`case wont directly solve that indeed, but is something for you to check up on. I'm curious though what exactly happens when you encounter a p.value of 1 for the second time, as the code for that is basicly the same. So does that overwrite your previous result as well? If so you should replace your `workbooks.add` by code to check if the workbook is already present or not. – Luuklag May 03 '18 at 12:18
  • @Luuklag oh ok, I shall study up on that. For the specifically defined variables (1-5) the code works as intended. Creates separate workbooks, as the condition of the SaveAs has the p.Value in the naming scheme. If you would like, i can provide you with a link with the file so you can try it out. – Marek Benus May 03 '18 at 12:27
  • But that will work the first time you encounter the p.Value, what happens when that same value is encountered the second time? Or is that not applicable? – Luuklag May 03 '18 at 12:31
  • As far as i know, and have observed the script working, all of the rows with the specific variable (for example 1) will be printed into the workbook at once due to the `Union(VariableRows, rw)` condition. But I might be wrong...it has been some time without VB for me... – Marek Benus May 03 '18 at 12:40

0 Answers0