• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Naming and Saving Workbooks created through VBA

Thing2

New Member
Hello! I am working on a large data set in which i'm using VBA to separate the worksheet into separate workbooks based on a specified column value. The code is working, however, I'm looking to better understand the code (I did not create it) and there are a few things I'm looking to add.

First, the VBA takes a long time. I'm not sure if I can really get around this, but I'd like to Application.DisplayAlerts = False and Application.ScreenUpdating = False as I've heard this helps the code run more quickly. I'm not sure where in the code these lines should go. Do they go at the end?

Second, I'd like for it to also name the newly created workbooks based on the column value as well as save it to the source file folder. I've seen other code that accomplishes both of these needs but am having trouble identifying how they do it as well as where in my current VBA to include those lines. Does anyone have any suggestions?

Lastly, as I said earlier, I did not create this code but I'm very interested in better understanding it yet it doesn't include many notes. Would anyone be able to help add notes/identify what various lines do?

Any support is greatly appreciated, please see the code below. Thank you!

>>> use code - tags <<<
Code:
Sub SplitSheetIntoMultipleWorkbooksBasedOnColumn()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
          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)
     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
               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:O").AutoFit
          End If
     Next
Next
End Sub
 
Last edited by a moderator:
Hello, as all is yet explained in VBA help …​
A faster way shoud be to just use an Excel advanced filter like any Excel beginner user can operate manually !​
A must see : Workbook.SaveAs method …​
It seems this code was not made to run under Excel with useless stuff and yes designed to be slow​
- weird logic, an excellent sample for students to not do ! -​
so you should better elaborate your need with details in order there is nothing to guess​
with at least an attachment of a source sample workbook and some expected results as stated here :​
 
Back
Top