• 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.

Create new workbooks with a variable name

Cabledguy

New Member
Hi All
Complete VBA noobie. Other modules are working now need to fix the export module.

Need to split up files based on column B - source system. It has the values AX or COM. Code does the splitting great - creates 2 new workbooks but doesn't name them.

Where I've added the comment (in CAPITALS) inside the IF statement, the variable strColumnValue is AX then COM. Does anyone know how at that point I can create and name the 2 workbooks?'

>>> use code - tags <<<
Code:
ub 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 CombinedData as the activeworksheet
Worksheets("CombinedData").Activate

    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 source (system) is in column B
        'The column can be changed here
        strColumnValue = objWorksheet.Range("B" & nRow).Value

        If objDictionary.Exists(strColumnValue) = False Then
           objDictionary.Add strColumnValue, 1
           MsgBox strColumnValue ' HERE THE  VARIABLE VALUES ARE AX THEN COM - How do I create workbooks with those names at this point?
        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)

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

        For nRow = 2 To nLastRow
            If CStr(objWorksheet.Range("B" & 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
 

Attachments

Last edited by a moderator:

Marc L

Excel Ninja
Hi,​
as you already have received help on another forum …​
A must read in particular for wild cross posting :​
 

Cabledguy

New Member
Thanks Marc - new here. Sorry this was a rush job I got handed. I'll try and keep X posting to a minimum. And from here on in I should have a bit more lead time.
 
Top