Fixing of VBA Code

[helplessnoobatexcel]

Sub SplitData()

Dim SplitFld As Range 'the column the end user will select to base the split on
Dim Hdgs As Range 'the headings needed on each worksheet
Dim SplitItem As Range 'the current value in the column that has been selected
Dim NewWs As Worksheet 'a new worksheet as required
Dim ws As Worksheet 'worksheets in the current workbook
Dim WsExists As Boolean 'TRUE or FALSE: does a worksheet already exist for the SplitItem?
Dim SplitWs As Worksheet 'The active worksheet

Set SplitWs = ActiveSheet

On Error GoTo SplitFldError 'if the user cancels the SplitFld inputbox exit sub
'ask user to select the column to base the split on and store that range in the SplitFld variable
Set SplitFld = Application.InputBox _
(Prompt:="Select the column you want to split your data by (***do not include the column heading***)", _
Title:="Column", Type:=8)

On Error GoTo HdgsError 'if the user cancels the Hdgs inputbox exit sub
'ask the user to select the column headings and store that range in the Hdgs variable
Set Hdgs = Application.InputBox _
(Prompt:="Select the headings you want to appear on each worksheet", _
Title:="Headings", Type:=8)


Application.ScreenUpdating = False 'turning off screen updating makes the code run faster

For Each SplitItem In SplitFld 'for each value in the column the user has selected
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name = SplitItem Then 'check whether a worksheet already exists for that value
            WsExists = True ' and store TRUE or FALSE in the WsExists variable
            Exit For
        Else
            WsExists = False
        End If
    Next ws

    
    If WsExists Then 'if WsExists = TRUE, (if the worksheet does already exist)
    
        'copy the record to the next available row in that worksheet
        Range(SplitItem.End(xlToLeft), SplitItem.End(xlToLeft).End(xlToRight)).Copy _
        Destination:=Worksheets(SplitItem.Value).Range("A1").End(xlDown).Offset(1, 0)
    
        Else 'if WsExists = 'FALSE (if a worksheet doesn't yet exist)
        
        'Create a new worksheet and place it to the right of other worksheets in the workbook
        Set NewWs = Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        'Name the worksheet using the current value stored in the SplitItem variable
        NewWs.Name = SplitItem
        
        'Copy the headings to the new worksheet
        Hdgs.Copy Destination:=NewWs.Range("A1")
        
        'Copy the record to the new worksheet
        Range(SplitItem.End(xlToLeft), SplitItem.End(xlToLeft).End(xlToRight)).Copy Destination:=NewWs.Range("A2")
        
    End If

Next SplitItem


For Each ws In ThisWorkbook.Worksheets 'autofit columns in each worksheet

    ws.UsedRange.Columns.AutoFit

Next ws

'turn screen updating back on
Application.ScreenUpdating = True

Exit Sub

SplitFldError:
Exit Sub

HdgsError:
Exit Sub
    
End Sub

Hi Guys, I currently have this VBA code that would help me split a main sheet of data into several sheets based o data in one column, along with the headers displayed in all the split sheets. Previously it worked fine for me when I ran it with 20 rows of data, but now that I have about 4200+ rows of data with about 20 names in the column, it would not be able to sort all the data into the relevant sheets. It also would not display all the headers despite me already highlighting which headers I want displayed. Any ideas on how I can fix this? Greatly appreciate your help!!

 

[jolivanes]

Would you be able to explain in a concise manner what you want to achieve?
I don't think that it is very difficult but I am not going to wade through 60 Rows of code to find out.

 

[helplessnoobatexcel]

Hi Jolivanes,

I want my data to be split into several sheets according to a column of names (user is able to select which column) and for the selected headers to be displayed in the split sheets. However the current code doesn't split all the data and display the correct headers

 

[jolivanes]

So you have columns with data. Column amount always the same or could it change to be more or sometimes less?
You want to select a column with an inputbox and a name from that same column also with an inputbox or get all the unique names from that column and copy the rows for each unique name to its own sheet? You also want to have only some headers copied into these sheets by the sound of it. I assume if you only want the headers for 4 different columns, you also want the data only for these columns copied and pasted. Are the headers all in Row #1 only?
Are there formulas involved or only text/values?