Jtdylktuy

I'm new here so please let me know if my post is incorrect or anything like that.

I currently have a macro that splits out one excel file into multiple files and saves them separately. This step I have found an answer to and am quite happy with.

I need these files to be password protected so when I email them out to clients I feel that they are being transmitted securely. Is there a macro that I can write/use to accomplish this trick for me.

My excel file Tab 1 houses all of my data and currently splits out everything based on column A.

John Test1

John Test2

John Test3

Alex Test4

Alex Test5

Frank Test6

Frank Test7

The macro I use splits this into separates file for John/Alex/Frank that shows only their data with none of the other individuals data.

I also have tab 2 that houses all of the passwords:

John Pw1

Alex Pw2

Frank Pw3

I am looking for a way to have the passwords listed in tab 2 to be applied to the newly created documents during the process of my current macro.

Any help on this would be greatly appreciated. Let me know if any of what I asked is unclear.

For reference I will quote the code I found from user mtone because this is the code I am currently using. This code has been very useful for me and I am extremely thankful to mtone for posting it. I don't believe I can send a private message to mtone but if I could I would thank him profusely!

    Public Sub SplitToFiles()



    ' MACRO SplitToFiles

    ' Last update: 2012-03-04

' Author: mtone

' Version 1.1

' Description:

' Loops through a specified column, and split each distinct values into a separate file by making a copy and deleting rows below and above

'

    ' Note: Values in the column should be unique or sorted.

'

' The following cells are ignored when delimiting sections:

' - blank cells, or containing spaces only

' - same value repeated

' - cells containing "total"

'

' Files are saved in a "Split" subfolder from the location of the source workbook, and named after the section name.



Dim osh As Worksheet ' Original sheet

Dim iRow As Long ' Cursors

Dim iCol As Long

Dim iFirstRow As Long ' Constant

Dim iTotalRows As Long ' Constant

Dim iStartRow As Long ' Section delimiters

Dim iStopRow As Long

Dim sSectionName As String ' Section name (and filename)

Dim rCell As Range ' current cell

Dim owb As Workbook ' Original workbook

Dim sFilePath As String ' Constant

Dim iCount As Integer ' # of documents created



iCol = Application.InputBox("Enter the column number used for splitting", "Select column", 2, , , , , 1)

iRow = Application.InputBox("Enter the starting row number (to skip header)", "Select row", 5, , , , , 1)

iFirstRow = iRow



Set osh = Application.ActiveSheet

Set owb = Application.ActiveWorkbook

iTotalRows = osh.UsedRange.Rows.Count

sFilePath = Application.ActiveWorkbook.Path



If Dir(sFilePath + "Split", vbDirectory) = "" Then

MkDir sFilePath + "Split"

End If



'Turn Off Screen Updating  Events

Application.EnableEvents = False

Application.ScreenUpdating = False



Do

' Get cell at cursor

Set rCell = osh.Cells(iRow, iCol)

sCell = Replace(rCell.Text, " ", "")



If sCell = "" Or (rCell.Text = sSectionName And iStartRow <> 0) Or InStr(1, rCell.Text, "total", vbTextCompare) <> 0 Then

    ' Skip condition met

Else

    ' Found new section

    If iStartRow = 0 Then

        ' StartRow delimiter not set, meaning beginning a new section

        sSectionName = rCell.Text

        iStartRow = iRow

    Else

        ' StartRow delimiter set, meaning we reached the end of a section

        iStopRow = iRow - 1



        ' Pass variables to a separate sub to create and save the new worksheet

        CopySheet osh, iFirstRow, iStartRow, iStopRow, iTotalRows, sFilePath, sSectionName, owb.fileFormat

        iCount = iCount + 1



        ' Reset section delimiters

        iStartRow = 0

        iStopRow = 0



        ' Ready to continue loop

        iRow = iRow - 1

    End If

End If



' Continue until last row is reached

If iRow < iTotalRows Then

        iRow = iRow + 1

Else

    ' Finished. Save the last section

    iStopRow = iRow

    CopySheet osh, iFirstRow, iStartRow, iStopRow, iTotalRows, sFilePath, sSectionName, owb.fileFormat

    iCount = iCount + 1



    ' Exit

    Exit Do

End If

Loop



'Turn On Screen Updating  Events

Application.ScreenUpdating = True

Application.EnableEvents = True



       MsgBox Str(iCount) + " documents saved in " + sFilePath





End Sub



Public Sub DeleteRows(targetSheet As Worksheet, RowFrom As Long, RowTo As Long)



    Dim rngRange As Range

Set rngRange = Range(targetSheet.Cells(RowFrom, 1), targetSheet.Cells(RowTo, 1)).EntireRow

rngRange.Select

rngRange.Delete



End Sub





Public Sub CopySheet(osh As Worksheet, iFirstRow As Long, iStartRow As Long, iStopRow As Long, iTotalRows As Long, sFilePath As String, sSectionName As String, fileFormat As XlFileFormat)

 Dim ash As Worksheet ' Copied sheet

 Dim awb As Workbook ' New workbook



 ' Copy book

 osh.Copy

 Set ash = Application.ActiveSheet



 ' Delete Rows after section

 If iTotalRows > iStopRow Then

     DeleteRows ash, iStopRow + 1, iTotalRows

 End If



 ' Delete Rows before section

 If iStartRow > iFirstRow Then

     DeleteRows ash, iFirstRow, iStartRow - 1

 End If



 ' Select left-topmost cell

 ash.Cells(1, 1).Select



 ' Clean up a few characters to prevent invalid filename

 sSectionName = Replace(sSectionName, "/", " ")

 sSectionName = Replace(sSectionName, "", " ")

 sSectionName = Replace(sSectionName, ":", " ")

 sSectionName = Replace(sSectionName, "=", " ")

 sSectionName = Replace(sSectionName, "*", " ")

 sSectionName = Replace(sSectionName, ".", " ")

 sSectionName = Replace(sSectionName, "?", " ")



 ' Save in same format as original workbook

 ash.SaveAs sFilePath + "Split" + sSectionName, fileFormat



 ' Close

 Set awb = ash.Parent

 awb.Close SaveChanges:=False

End Sub

I need these files to be password protected so when I email them out to clients I feel that they are being transmitted securely.

Password protecting excel files should not be considered secure. There are multiple options online for cracking these type of documents, and even newer versions of excel still have security vulnerabilities. If the files contain sensitive data you should consider some other kind of encryption such as PGP.