VBA - Create new Workbooks from a Table using Unique Values

Copper Contributor

Greetings!

 

I have a rudimentary understanding of how VBA works but have very little skill/ability in VBA code. I am trying to create a VBA script that will iterate through a Table and create new workbooks with the table contents based on the values in the first column. 

 

CustomerDeliveryDateCustomerItemCode
00000145437A
00000145437B
00000245437A
00000245437C
00000245437F
00004145437A
00004145437B

 

This table is the output of a query titled "Table". The desired outcome would be if the macro could generate workbooks for each of the Customers with the data from the table associated to their Customer Number and the filename of the output would be the Customer Number and the Date that it is generated. 

 

 

The current code I'm experimenting with is below but it is creating the same workbook over and over and not depositing any data in the workbook that is getting created. 

 

 

Sub OrderCopy()

    Dim tbl As ListObject
    Set tbl = Workbooks("Order Generator").Worksheets("MarketPlace").ListObjects("MarketPlace")
    
    Dim col As Range
    Set col = tbl.ListColumns("StoreNo").DataBodyRange
    
    Dim oWorkbook As Excel.Workbook
    Dim oCell As Excel.Range
     

       
    Application.DisplayAlerts = False
    
    For Each oCell In col
    
        If oCell.Value = "" Then Exit For
        
        Set oWorkbook = Workbooks.Add
        
        oWorkbook.Sheets(1).Cells(1, 1).Value = col.Offset(0, 1).Value
        
        oWorkbook.Close True, col.Value
        
    Next oCell
    
    Application.DisplayAlert5s = True



End Sub

 

 

1 Reply

Instead of col.Value, use oCell.Value and instead of 

col.Offset(0, 1).Value

use

oCell.Offset(0, 1).Value