Splitting sheets with VBA, but creates extra sheet

STEEL010

Board Regular
Joined
Dec 29, 2017
Messages
76
Hi There, Happy new year to all!

I'm trying to solve a problem that I have from a VAB code that I have found on the Internet.
its about splitting one sheet into multiple sheets. Code runs fine but every time it gives me a extra sheet that I don't want like ("sheet69"). Is this problem ready known by some people? please help,help is much appreciated.

hereby the code:

Code:
Private Sub CommandButton1_Click()
Dim lr As Long
    Dim ws As Worksheet
    Dim vcol, i As Integer
    Dim icol As Long
    Dim myarr As Variant
    Dim title As String
    Dim titlerow As Integer

    vcol = 4
    Set ws = Sheets("Mastersheet")

    lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
    title = "A1:E100"
    titlerow = ws.Range(title).Cells(2).Row
    icol = ws.Columns.Count
    ws.Cells(1, icol) = "Unique"

    For i = 2 To lr
        On Error Resume Next
        If ws.Cells(i, vcol) <> "" And Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(icol), 0) = 0 Then
            ws.Cells(ws.Rows.Count, icol).End(xlUp).Offset(1) = ws.Cells(i, vcol)
        End If
    Next

    myarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))
    ws.Columns(icol).Clear
    For i = 2 To UBound(myarr)
        ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""
        If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then
            Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = myarr(i) & ""
        Else
            Sheets(myarr(i) & "").Move after:=Worksheets(Worksheets.Count)
        End If
        ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A1")
        Sheets(myarr(i) & "").Columns.AutoFit
    Next
    ws.AutoFilterMode = False
    ws.Activate
End Sub

Greeting Steel010
 
Last edited by a moderator:

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().
That formula shouldn't be a problem, but it sound like one of your cells contains 1 or more spaces or something similar.
In a blank column put
=LEN(D2) & copy down.
Does the formula return any other than 0 for "Blank" cells?
 
Upvote 0
What do you mean "all cells are empty"?
 
Upvote 0
Fluff I have found the problem, all cells in D so D2 to D100 have a vlookup value hidden with =iferror. we I manuall remove this then your formula work like a thunderstorm without the extra blank sheet. so is there an tweak in VBA that when I have 5 rows with info that the other row can be delete automatically?
 
Upvote 0
Can you please answer the question I asked in post#12?
 
Upvote 0
This code
Code:
Sub Steel010()
   Dim Cl As Range
   Dim ws As Worksheet
   Dim Ky As Variant
   
   Application.ScreenUpdating = False
   Set ws = Sheets("MasterSheet")
   With CreateObject("scripting.dictionary")
      For Each Cl In ws.Range("D2", ws.Range("D" & Rows.Count).End(xlUp))
         If Not .Exists(Cl.Value) And Cl.Value <> "" Then .Add Cl.Value, Nothing
      Next Cl
      For Each Ky In .Keys
         ws.Range("A1").AutoFilter 4, Ky
         Sheets.Add(, ws).Name = Ky
         ws.AutoFilter.Range.EntireRow.Copy Sheets(Ky).Range("A1")
         Sheets(Ky).Columns.AutoFit
      Next Ky
   End With
   ws.AutoFilterMode = False
   ws.Activate
End Sub
should not give a "Blank" sheet, unless you have "blank" cells in col D that look blank but in fact contain something other than the formula.
 
Last edited:
Upvote 0
One thought, what sheet are you trying to split?
Your original code is splitting sheet "Mastersheet", but looking at the formula in post#11 it looks as though that is on a different sheet.
 
Upvote 0

Forum statistics

Threads
1,223,236
Messages
6,170,917
Members
452,366
Latest member
TePunaBloke

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