question

BrennieB-0050 avatar image
0 Votes"
BrennieB-0050 asked AnandYadav-7784 answered

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

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.

office-vba-dev
5 |1600 characters needed characters left characters exceeded

Up to 10 attachments (including images) can be used with a maximum of 3.0 MiB each and 30.0 MiB total.

BrennieB-0050 avatar image
0 Votes"
BrennieB-0050 answered JohnKorchok commented

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!

5 |1600 characters needed characters left characters exceeded

Up to 10 attachments (including images) can be used with a maximum of 3.0 MiB each and 30.0 MiB total.

AnandYadav-7784 avatar image
0 Votes"
AnandYadav-7784 answered

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.


5 |1600 characters needed characters left characters exceeded

Up to 10 attachments (including images) can be used with a maximum of 3.0 MiB each and 30.0 MiB total.