VBA to split data by values in a specific column - issue setting range

[dougmarkham]

Hi Folks,

I have this code below for selecting a column and splitting the rows of data into different worksheets dependent upon the value in the selected column.
I have found that to make it work best, the data is better being without formatting (no autofilter, no dynamic table, no borders, no interior color etc) i.e., just cell values.

Sub SplitData()
 
Dim InvoiceWorkbook As String
Dim Invoice As String
 
InvoiceWorkbook = ActiveWorkbook.Name
Invoice = ActiveSheet.Name
 
vColumn = InputBox("Please indicate which column (i.e. A, B, C, …), you would like to split by", "Column selection")
 
Columns(vColumn).Copy
Sheets.Add
ActiveSheet.Name = "_Summary"
Range("A1").PasteSpecial
Columns("A").RemoveDuplicates Columns:=1, Header:=xlYes
 
vCounter = Range("A" & Rows.Count).End(xlUp).Row
 
For I = 2 To vCounter
    vfilter = Sheets("_Summary").Cells(I, 1)
    Worksheets("Invoice").Activate
    ActiveSheet.Columns.AutoFilter field:=Columns(vColumn).Column, Criteria1:=vfilter
    Dim wksSourceSheet, wksTargetSheet
    Set wksSourceSheet = ActiveSheet
    ActiveWorkbook.Sheets.Add after:=Worksheets(Worksheets.Count)
    Set wksTargetSheet = ActiveSheet
    wksSourceSheet.Activate
    [COLOR=#0000ff][B]wksSourceSheet.Range("[/B][/COLOR][COLOR=#ff0000][B]A1:AQ5000[/B][/COLOR][COLOR=#0000ff][B]").Copy wksTargetSheet.Range("[/B][/COLOR][COLOR=#ff0000][B]A1:AQ5000[/B][/COLOR][COLOR=#0000ff][B]")[/B][/COLOR]
    wksTargetSheet.Activate
    If vfilter <> "" Then
        ActiveSheet.Name = vfilter
        Else
        Application.DisplayAlerts = False
        ActiveWindow.SelectedSheets.Delete
        Application.DisplayAlerts = True
    End If
    'Activate Workbook
    Workbooks(InvoiceWorkbook).Activate
Next I
Sheets("_Summary").Delete
 
End Sub

I wish to use it to split a daily report that varies in number of rows and columns.
The issue is that if I use a range (e.g., that shown in red) which covers the data easily, I get one of the split worksheets duplicating lines iteratively (over and over).
If I restrict the range to the actual range, the split works perfectly.

So, I'm wondering if it is possible to previously specify the range by set range.

E.g.,

Sub SplitInvoiceByOrderRef()
'Selects data range: A1, then ctrl/shift Right Arrow, Down Arrow.
    Dim [COLOR=#ff0000][B]rngMyRange[/B][/COLOR] As Range
    Dim sht As Worksheet
    Dim LastRow As Long
    Dim LastColumn As Long
    Dim StartCell As Range


    Set wksSourceSheet = Worksheets("Invoice")
    Set StartCell = Range("a1")


'Find Last Row and Column
    LastRow = wksSourceSheet.Cells(wksSourceSheet.Rows.Count, StartCell.Column).End(xlUp).Row
    LastColumn = wksSourceSheet.Cells(StartCell.Row, wksSourceSheet.Columns.Count).End(xlToLeft).Column


'Select Range
    wksSourceSheet.Range(StartCell, wksSourceSheet.Cells(LastRow, LastColumn)).Select
    Set [COLOR=#ff0000][B]rngMyRange[/B][/COLOR] = Selection
    
'Splits data by specific column
Dim InvoiceWorkbook As String
Dim Invoice As String


InvoiceProcessing = ActiveWorkbook.Name
Invoice = ActiveSheet.Name


Worksheets("Invoice").Activate
vColumn = InputBox("Please indicate which column (i.e. A, B, C, …), you would like to split by", "Column selection")


Columns(vColumn).Copy
Sheets.Add
ActiveSheet.Name = "_Summary"
Range("A1").PasteSpecial
Columns("A").RemoveDuplicates Columns:=1, Header:=xlYes


vCounter = Range("A" & Rows.Count).End(xlUp).Row


For i = 2 To vCounter
    vfilter = Sheets("_Summary").Cells(i, 1)
    Worksheets("Invoice").Activate
    ActiveSheet.Columns.AutoFilter field:=Columns(vColumn).Column, Criteria1:=vfilter
    Dim wksTargetSheet
    Set wksSourceSheet = ActiveSheet
    ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
    Set wksTargetSheet = ActiveSheet
    wksSourceSheet.Activate
[COLOR=#0000ff][B]    wksSourceSheet.Range([/B][/COLOR][COLOR=#ff0000][B]rngMyRange[/B][/COLOR][COLOR=#0000ff][B]).Copy wksTargetSheet.Range([/B][/COLOR][COLOR=#ff0000][B]rngMyRange[/B][/COLOR][COLOR=#0000ff][B])[/B][/COLOR]
    wksTargetSheet.Activate
    If vfilter <> "" Then
        ActiveSheet.Name = vfilter
        Else
        Application.DisplayAlerts = False
        ActiveWindow.SelectedSheets.Delete
        Application.DisplayAlerts = True
    End If
    'Activate Workbook
    Workbooks(InvoiceWorkbook).Activate
Next i
Sheets("_Summary").Delete
On Error Resume Next
End Sub

Currently, the excel VB editor is rejecting this line:

[COLOR=#0000FF][B]   wksSourceSheet.Range([/B][/COLOR][COLOR=#FF0000][B]rngMyRange[/B][/COLOR][COLOR=#0000FF][B]).Copy wksTargetSheet.Range([/B][/COLOR][COLOR=#FF0000][B]rngMyRange[/B][/COLOR][COLOR=#0000FF][B])[/B][/COLOR]

Would anybody be willing to help me find a way to use a dynamic auto-adjusting VBA range within this split code, or suggest a better way of doing this?

Kind regards,

Doug.

 

[dmt32]

Hi,
Assuming worksheet is not protected, try changing this line

wksSourceSheet.Range("A1:AQ5000").Copy wksTargetSheet.Range("A1:AQ5000")

to this

wksSourceSheet.Range("A1").CurrentRegion.Copy wksTargetSheet.Range("A1")

and see if this will do what you want

Dave

 

[dougmarkham]

Hi,
Assuming worksheet is not protected, try changing this line

wksSourceSheet.Range("A1:AQ5000").Copy wksTargetSheet.Range("A1:AQ5000")

to this

wksSourceSheet.Range("A1").CurrentRegion.Copy wksTargetSheet.Range("A1")

and see if this will do what you want

Dave

Hi Dave,

CurrentRegion.Copy seems to have encapsulated all the data: it's worked a treat. Thanks for helping me out!

Kind regards,

Doug.

 

[dmt32]

Hi,
glad suggestion helped

Many thanks for feedback

Dave