Object Required Error in VBA,

Sharda

New Member
Joined
Nov 19, 2017
Messages
15
Sub Split()


Dim wb As String
Dim ws As String


wb = ActiveWorkbook.Name
ws = 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:=x1Yes


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


For i = 2 To vCounter
vfilter = Sheets("_Summary").Cells(i, 1)
Sheets(ws).Activate
ActiveSheet.Columns.AutoFilter field:=Columns(Vcolumn).Column, Criteria1:=vfilter
Cells.Copy
Workbooks.Add
Range("A1").PasteSpecial
If vfilter <> "" Then
ActiveWorkbook.SaveAs ThiWorkbook.Path & "\Split Result" & vfilter
Else
ActiveWorkbook.SaveAs ThisWorkbook.Path & "Split Result\_Empty"
End If
ActiveWorkbook.Close
Workbooks(wb).Activate
Next i


Sheets("_Summary").Delete


End Sub
 

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
I'm applying above VBA on below Excel, where I want my first row to be constant. Many Thanks in Advance for help.
[TABLE="width: 600"]
<colgroup><col span="3"><col><col><col span="4"></colgroup><tbody>[TR]
[TD="colspan: 2"]LEDES98BI V2[][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]INVOICE_DATE[/TD]
[TD]INVOICE_NUMBER[/TD]
[TD]CLIENT_ID[/TD]
[TD]LAW_FIRM_MATTER_ID[/TD]
[TD]INVOICE_TOTAL[/TD]
[TD]BILLING_START_DATE[/TD]
[TD]BILLING_END_DATE[/TD]
[TD]INVOICE_DESCRIPTION[/TD]
[TD]LINE_ITEM_NUMBER[/TD]
[/TR]
[TR]
[TD="align: right"]20171031[/TD]
[TD="align: right"]1040448[/TD]
[TD="align: right"]37160[/TD]
[TD]43168082-2015-14[/TD]
[TD="align: right"]532[/TD]
[TD="align: right"]20171001[/TD]
[TD="align: right"]20171031[/TD]
[TD]Processing[/TD]
[TD="align: right"]1[/TD]
[/TR]
[TR]
[TD="align: right"]20171031[/TD]
[TD="align: right"]1040450[/TD]
[TD="align: right"]37160[/TD]
[TD]43326013-2012-13[/TD]
[TD="align: right"]2270.5[/TD]
[TD="align: right"]20171001[/TD]
[TD="align: right"]20171031[/TD]
[TD]Processing[/TD]
[TD="align: right"]1[/TD]
[/TR]
</tbody>[/TABLE]
 
Upvote 0
Hi & welcome to the board.
I suspect the line that is causing the problem is this
Code:
vCounter = Range("B" & Row.Count).End(xlUp).Row
which should be
Code:
vCounter = Range("B" & [COLOR=#ff0000]Rows[/COLOR].Count).End(xlUp).Row
Even so that will not work, as you have copied 1 column into col A so col B is blank. Therefore vCounter will =1 & your loop will then be from 2 to 1.
Could you please explain what you are try to achieve.
 
Upvote 0
Thanks Mr. Fluff for immediate response.
I'm a beginner with VBA stuff.
And need to split huge data into multiple csv's and found this script online which help to split data into multiple excels.
I didn't change script to column B
Because as soon as we run script it asks for which column you want split
I could be wrong on that.
Please see if you assist me this will be grateful.
 
Upvote 0
Give this a go
Code:
Sub Split()

    Dim SrcSht As Worksheet
    Dim TmpSht As Worksheet
    Dim vCounter As Long
    Dim vColumn As String
    Dim vFilter As String
    Dim i As Long
    
    Set SrcSht = ActiveSheet
    vColumn = InputBox("Please indicate which column (i.e. A,B,C,...), you would like to split by", "Column selection")
    
    Sheets.Add.Name = "_Summary"
    Set TmpSht = ActiveSheet
    
    SrcSht.Columns(vColumn).copy TmpSht.Range("A1")
    TmpSht.Columns("A").RemoveDuplicates Columns:=1, Header:=xlYes
    
    vCounter = SrcSht.Range("B" & Rows.Count).End(xlUp).Row
    
    For i = 2 To vCounter
        vFilter = TmpSht.Range("A" & i)
        SrcSht.Columns.AutoFilter field:=Columns(vColumn).Column, Criteria1:=vFilter
        Workbooks.Add
        SrcSht.Range("A1").CurrentRegion.SpecialCells(xlVisible).copy ActiveWorkbook.Sheets(1).Range("A1")
        ActiveWorkbook.SaveAs fileName:=ThisWorkbook.path & "\Split Result" & vFilter, FileFormat:=6
        ActiveWorkbook.Close False
    Next i
    TmpSht.Delete

End Sub
 
Upvote 0
Thanks Fluff for all the efforts. However, I want first two row of my data to be constant. I tried with "If vCounter < 2 Then" but i'm getting error "Block IF without End If"
Could please advise a way out.

My Data (Blue Highlighted) are constant row (Headers):

[TABLE="width: 472"]
<colgroup><col span="3"><col><col><col span="2"></colgroup><tbody>[TR]
[TD="colspan: 2"]LEDES98BI V2[][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]INVOICE_DATE[/TD]
[TD]INVOICE_NUMBER[/TD]
[TD]CLIENT_ID[/TD]
[TD]LAW_FIRM_MATTER_ID[/TD]
[TD]INVOICE_TOTAL[/TD]
[TD]BILLING_START_DATE[/TD]
[TD]BILLING_END_DATE[/TD]
[/TR]
[TR]
[TD="align: right"]20171031[/TD]
[TD="align: right"]1040448[/TD]
[TD="align: right"]37160[/TD]
[TD]43168082-2015-14[/TD]
[TD="align: right"]532[/TD]
[TD="align: right"]20171001[/TD]
[TD="align: right"]20171031[/TD]
[/TR]
[TR]
[TD="align: right"]20171031[/TD]
[TD="align: right"]1040450[/TD]
[TD="align: right"]37160[/TD]
[TD]43326013-2012-13[/TD]
[TD="align: right"]2270.5[/TD]
[TD="align: right"]20171001[/TD]
[TD="align: right"]20171031[/TD]
[/TR]
</tbody>[/TABLE]
Sub Split()


Dim SrcSht As Worksheet
Dim TmpSht As Worksheet
Dim vCounter As Long
Dim vColumn As String
Dim vFilter As String
Dim i As Long

Set SrcSht = ActiveSheet
vColumn = InputBox("Please indicate which column (i.e. A,B,C,...), you would like to split by", "Column selection")

Sheets.Add.Name = "_Summary"
Set TmpSht = ActiveSheet

SrcSht.Columns(vColumn).Copy TmpSht.Range("A1")
TmpSht.Columns("B").RemoveDuplicates Columns:=1, Header:=xlYes


vCounter = SrcSht.Range("B" & Rows.Count).End(xlUp).Row
If vCounter < 2 Then

For i = 2 To vCounter
vFilter = TmpSht.Range("A" & i)
SrcSht.Columns.AutoFilter field:=Columns(vColumn).Column, Criteria1:=vFilter
Workbooks.Add
SrcSht.Range("A1").CurrentRegion.SpecialCells(xlVisible).Copy ActiveWorkbook.Sheets(1).Range("A1")
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\Split Result" & vFilter, FileFormat:=6
ActiveWorkbook.Close False
Next i
End Sub
TmpSht.Delete
 
Upvote 0
Every If needs and End If

For future please enclose your code in Tags (Select it when entering and click the "#" button in the editor menu

Code:
Dim SrcSht As Worksheet
    Dim TmpSht As Worksheet
    Dim vCounter As Long
    Dim vColumn As String
    Dim vFilter As String
    Dim i As Long

    Set SrcSht = ActiveSheet
    vColumn = InputBox("Please indicate which column (i.e. A,B,C,...), you would like to split by", "Column selection")

    Sheets.Add.Name = "_Summary"
    Set TmpSht = ActiveSheet

    SrcSht.Columns(vColumn).Copy TmpSht.Range("A1")
    TmpSht.Columns("B").RemoveDuplicates Columns:=1, Header:=xlYes


    vCounter = SrcSht.Range("B" & Rows.Count).End(xlUp).Row
    If vCounter < 2 Then

[COLOR=#ff0000]    [/COLOR]For i = 2 To vCounter[COLOR=#ff0000][/COLOR]
        vFilter = TmpSht.Range("A" & i)
        SrcSht.Columns.AutoFilter field:=Columns(vColumn).Column, Criteria1:=vFilter
        Workbooks.Add
        SrcSht.Range("A1").CurrentRegion.SpecialCells(xlVisible).Copy ActiveWorkbook.Sheets(1).Range("A1")
        ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\Split Result" & vFilter, FileFormat:=6
        ActiveWorkbook.Close False
    Next i
 End Sub
[COLOR=#FF0000][B]End if[/B][/COLOR]
    TmpSht.Delete
 
Upvote 0
Sure Stiuart! going forward I'll enclose code as advised. However I'm still getting similar error.
Just to give you gist about what I'm looking for is I have bulk Data that I want to split in individual CSV file.
For which we got successful with script provided by Mr. Fluff, but Instead of one row, I want to keep two rows of my data constant.
Could you help by any chance..?
Many Thanks in advance!
 
Upvote 0
Sorry. I put the End If statement outside the End Sub


Code:
Dim SrcSht As Worksheet
    Dim TmpSht As Worksheet
    Dim vCounter As Long
    Dim vColumn As String
    Dim vFilter As String
    Dim i As Long

    Set SrcSht = ActiveSheet
    vColumn = InputBox("Please indicate which column (i.e. A,B,C,...), you would like to split by", "Column selection")

    Sheets.Add.Name = "_Summary"
    Set TmpSht = ActiveSheet

    SrcSht.Columns(vColumn).Copy TmpSht.Range("A1")
    TmpSht.Columns("B").RemoveDuplicates Columns:=1, Header:=xlYes


    vCounter = SrcSht.Range("B" & Rows.Count).End(xlUp).Row
    If vCounter < 2 Then

For i = 2 To vCounter
        vFilter = TmpSht.Range("A" & i)
        SrcSht.Columns.AutoFilter field:=Columns(vColumn).Column, Criteria1:=vFilter
        Workbooks.Add
        SrcSht.Range("A1").CurrentRegion.SpecialCells(xlVisible).Copy ActiveWorkbook.Sheets(1).Range("A1")
        ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\Split Result" & vFilter, FileFormat:=6
        ActiveWorkbook.Close False
    Next i
 
[COLOR=#ff0000][B]End if[/B][/COLOR]
    TmpSht.Delete
End Sub
 
Upvote 0
re think
 
Last edited:
Upvote 0

Forum statistics

Threads
1,223,164
Messages
6,170,444
Members
452,326
Latest member
johnshaji

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top