423,680 Members | 2,394 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 423,680 IT Pros & Developers. It's quick & easy.

Where is it limiting the length of column A?

P: 19
Hi. I found some code that does exactly what I want it to do except it stops if the length of a name in column A is more than 31 characters. I do not even see the error message in this code let alone where it is doing it. I hope someone can help me. thanks in advance.
Expand|Select|Wrap|Line Numbers
  1. Option Explicit
  2.  
  3. '<<<<  Create a new sheet for every Unique value  >>>>>
  4.  
  5. 'This example copy all rows with the same value in the first column of
  6. 'the range to a new worksheet. It will do this for every unique value.
  7. 'The sheets will be named after the Unique value.
  8.  
  9. 'Note: this example use the function LastRow in the ModReset module
  10.  
  11. Sub Copy_To_Worksheets()
  12. 'Note: This macro use the function LastRow
  13.     Dim My_Range As Range
  14.     Dim FieldNum As Long
  15.     Dim CalcMode As Long
  16.     Dim ViewMode As Long
  17.     Dim ws2 As Worksheet
  18.     Dim Lrow As Long
  19.     Dim cell As Range
  20.     Dim CCount As Long
  21.     Dim WSNew As Worksheet
  22.     Dim ErrNum As Long
  23.  
  24.     'Set filter range on ActiveSheet: A11 is the top left cell of your filter range
  25.     'and the header of the first column, D is the last column in the filter range.
  26.     'You can also add the sheet name to the code like this :
  27.     'Worksheets("Sheet1").Range("A11:D" & LastRow(Worksheets("Sheet1")))
  28.     'No need that the sheet is active then when you run the macro when you use this.
  29.     Set My_Range = Range("A11:D" & LastRow(ActiveSheet))
  30.     My_Range.Parent.Select
  31.  
  32.     If ActiveWorkbook.ProtectStructure = True Or _
  33.        My_Range.Parent.ProtectContents = True Then
  34.         MsgBox "Sorry, not working when the workbook or worksheet is protected", _
  35.                vbOKOnly, "Copy to new worksheet"
  36.         Exit Sub
  37.     End If
  38.  
  39.     'This example filters on the first column in the range(change the field if needed)
  40.     'In this case the range starts in A so Field:=1 is column A, 2 = column B, ......
  41.     FieldNum = 1
  42.  
  43.     'Turn off AutoFilter
  44.     My_Range.Parent.AutoFilterMode = False
  45.  
  46.     'Change ScreenUpdating, Calculation, EnableEvents, ....
  47.     With Application
  48.         CalcMode = .Calculation
  49.         .Calculation = xlCalculationManual
  50.         .ScreenUpdating = False
  51.         .EnableEvents = False
  52.     End With
  53.     ViewMode = ActiveWindow.View
  54.     ActiveWindow.View = xlNormalView
  55.     ActiveSheet.DisplayPageBreaks = False
  56.  
  57.     'Add a worksheet to copy the a unique list and add the CriteriaRange
  58.     Set ws2 = Worksheets.Add
  59.  
  60.     With ws2
  61.         'first we copy the Unique data from the filter field to ws2
  62.         My_Range.Columns(FieldNum).AdvancedFilter _
  63.                 Action:=xlFilterCopy, _
  64.                 CopyToRange:=.Range("A1"), Unique:=True
  65.  
  66.         'loop through the unique list in ws2 and filter/copy to a new sheet
  67.         Lrow = .Cells(Rows.Count, "A").End(xlUp).Row
  68.         For Each cell In .Range("A2:A" & Lrow)
  69.  
  70.             'Filter the range
  71.             My_Range.AutoFilter Field:=FieldNum, Criteria1:="=" & _
  72.                                                             Replace(Replace(Replace(cell.Value, "~", "~~"), "*", "~*"), "?", "~?")
  73.  
  74.             'Check if there are no more then 8192 areas(limit of areas)
  75.             CCount = 0
  76.             On Error Resume Next
  77.             CCount = My_Range.Columns(1).SpecialCells(xlCellTypeVisible) _
  78.                      .Areas(1).Cells.Count
  79.             On Error GoTo 0
  80.             If CCount = 0 Then
  81.                 MsgBox "There are more than 8192 areas for the value : " & cell.Value _
  82.                      & vbNewLine & "It is not possible to copy the visible data." _
  83.                      & vbNewLine & "Tip: Sort your data before you use this macro.", _
  84.                        vbOKOnly, "Split in worksheets"
  85.             Else
  86.                 'Add a new worksheet
  87.                 Set WSNew = Worksheets.Add(After:=Sheets(Sheets.Count))
  88.                 On Error Resume Next
  89.                 WSNew.Name = cell.Value
  90.                 If Err.Number > 0 Then
  91.                     ErrNum = ErrNum + 1
  92.                     WSNew.Name = "Error_" & Format(ErrNum, "0000")
  93.                     Err.Clear
  94.                 End If
  95.                 On Error GoTo 0
  96.  
  97.                 'Copy the visible data to the new worksheet
  98.                 My_Range.SpecialCells(xlCellTypeVisible).Copy
  99.                 With WSNew.Range("A1")
  100.                     ' Paste:=8 will copy the columnwidth in Excel 2000 and higher
  101.                     ' Remove this line if you use Excel 97
  102.                     .PasteSpecial Paste:=8
  103.                     .PasteSpecial xlPasteValues
  104.                     .PasteSpecial xlPasteFormats
  105.                     Application.CutCopyMode = False
  106.                     .Select
  107.                 End With
  108.             End If
  109.  
  110.             'Show all data in the range
  111.             My_Range.AutoFilter Field:=FieldNum
  112.  
  113.         Next cell
  114.  
  115.         'Delete the ws2 sheet
  116.         On Error Resume Next
  117.         Application.DisplayAlerts = False
  118.         .Delete
  119.         Application.DisplayAlerts = True
  120.         On Error GoTo 0
  121.  
  122.     End With
  123.  
  124.     'Turn off AutoFilter
  125.     My_Range.Parent.AutoFilterMode = False
  126.  
  127.     If ErrNum > 0 Then
  128.         MsgBox "Rename every WorkSheet name that start with ""Error_"" manually" _
  129.              & vbNewLine & "There are characters in the name that are not allowed" _
  130.              & vbNewLine & "in a sheet name or the worksheet already exist."
  131.     End If
  132.  
  133.     'Restore ScreenUpdating, Calculation, EnableEvents, ....
  134.     My_Range.Parent.Select
  135.     ActiveWindow.View = ViewMode
  136.     With Application
  137.         .ScreenUpdating = True
  138.         .EnableEvents = True
  139.         .Calculation = CalcMode
  140.     End With
  141.  
  142. End Sub
  143.  
  144.  
Aug 5 '15 #1

✓ answered by borlowski

Duh. I figured it out. You can't have more than 31 characters/spaces in a worksheet name.

Share this Question
Share on Google+
1 Reply


P: 19
Duh. I figured it out. You can't have more than 31 characters/spaces in a worksheet name.
Aug 5 '15 #2

Post your reply

Sign in to post your reply or Sign up for a free account.