How to do...Name, Save and Close Workbooks VBA

Question

Hi there. New to VBA and kind of learning as I go.

We have an Excel file that is about 60k lines long that I have figured out how to break out into different workbooks based on the value in column A. It ends up producing about 150 workbooks.

The problem is, my computer doesn't have enough memory to store all of the files open that it creates with the 62k lines and so I want to do the following:

Once a workbook is created, I want to save the file to the network drive H using the values in Column A Row 2 then Column B Row 2 then today's date.xlsx then I want to close the file so that they do not take up all of my RAM.

So for example file one would look like 1445Company1 07.27.21.xlsx and then it would save to my H drive and close.

I haven't quite found the correct combination of code to do so.

Can anyone help?

Thanks.

Answer 1

I don't have the code for this yet. I only have come as far as splitting it into different workbooks. However, when I run it, my computer can not handle the volume, so I want to try and incorporate the naming to the network drive and saving in the process so I can run the entire program.

This is what I have so far...

Sub SplitSheetDataIntoMultipleWorkbooksBasedOnSpecificColumn()
Dim objWorksheet As Excel.Worksheet
Dim nLastRow, nRow, nNextRow As Integer
Dim strColumnValue As String
Dim objDictionary As Object
Dim varColumnValues As Variant
Dim varColumnValue As Variant
Dim objExcelWorkbook As Excel.Workbook
Dim objSheet As Excel.Worksheet

Set objWorksheet = ActiveSheet
nLastRow = objWorksheet.Range("A" & objWorksheet.Rows.Count).End(xlUp).Row

Set objDictionary = CreateObject("Scripting.Dictionary")

For nRow = 2 To nLastRow
    'Get the specific Column
    'Here my instance is "B" column
    'You can change it to your case
    strColumnValue = objWorksheet.Range("A" & nRow).Value

    If objDictionary.Exists(strColumnValue) = False Then
       objDictionary.Add strColumnValue, 1
    End If
Next

varColumnValues = objDictionary.Keys

For i = LBound(varColumnValues) To UBound(varColumnValues)
    varColumnValue = varColumnValues(i)

    'Create a new Excel workbook
    Set objExcelWorkbook = Excel.Application.Workbooks.Add
    Set objSheet = objExcelWorkbook.Sheets(1)
    objSheet.Name = objWorksheet.Name

    objWorksheet.Rows(1).EntireRow.Copy
    objSheet.Activate
    objSheet.Range("A1").Select
    objSheet.Paste

    For nRow = 2 To nLastRow
        If CStr(objWorksheet.Range("A" & nRow).Value) = CStr(varColumnValue) Then
           'Copy data with the same column "B" value to new workbook
           objWorksheet.Rows(nRow).EntireRow.Copy

           nNextRow = objSheet.Range("A" & objWorksheet.Rows.Count).End(xlUp).Row + 1
           objSheet.Range("A" & nNextRow).Select
           objSheet.Paste
           objSheet.Columns("A:B").AutoFit
        End If
    Next
Next

End Sub

I was playing with this...but I know it isn't right yet. Totally new to VBA so trying my best to piece it together.

objExcelWorkbook.SaveAs Filename:=path & wksht.Range("c3").Value & ".xlsx", FileFormat:=xlOpenXMLWorkbook
Application.DisplayAlerts = True
objExcelWorkbook.Close

Any ideas help!

Thanks!

Answer 2

Thanks for the solution, I had the same issue. Glad I came across this to solve it. Excel VBA is the best tool solve many problems.