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. -
Option Explicit
-
-
'<<<< Create a new sheet for every Unique value >>>>>
-
-
'This example copy all rows with the same value in the first column of
-
'the range to a new worksheet. It will do this for every unique value.
-
'The sheets will be named after the Unique value.
-
-
'Note: this example use the function LastRow in the ModReset module
-
-
Sub Copy_To_Worksheets()
-
'Note: This macro use the function LastRow
-
Dim My_Range As Range
-
Dim FieldNum As Long
-
Dim CalcMode As Long
-
Dim ViewMode As Long
-
Dim ws2 As Worksheet
-
Dim Lrow As Long
-
Dim cell As Range
-
Dim CCount As Long
-
Dim WSNew As Worksheet
-
Dim ErrNum As Long
-
-
'Set filter range on ActiveSheet: A11 is the top left cell of your filter range
-
'and the header of the first column, D is the last column in the filter range.
-
'You can also add the sheet name to the code like this :
-
'Worksheets("Sheet1").Range("A11:D" & LastRow(Worksheets("Sheet1")))
-
'No need that the sheet is active then when you run the macro when you use this.
-
Set My_Range = Range("A11:D" & LastRow(ActiveSheet))
-
My_Range.Parent.Select
-
-
If ActiveWorkbook.ProtectStructure = True Or _
-
My_Range.Parent.ProtectContents = True Then
-
MsgBox "Sorry, not working when the workbook or worksheet is protected", _
-
vbOKOnly, "Copy to new worksheet"
-
Exit Sub
-
End If
-
-
'This example filters on the first column in the range(change the field if needed)
-
'In this case the range starts in A so Field:=1 is column A, 2 = column B, ......
-
FieldNum = 1
-
-
'Turn off AutoFilter
-
My_Range.Parent.AutoFilterMode = False
-
-
'Change ScreenUpdating, Calculation, EnableEvents, ....
-
With Application
-
CalcMode = .Calculation
-
.Calculation = xlCalculationManual
-
.ScreenUpdating = False
-
.EnableEvents = False
-
End With
-
ViewMode = ActiveWindow.View
-
ActiveWindow.View = xlNormalView
-
ActiveSheet.DisplayPageBreaks = False
-
-
'Add a worksheet to copy the a unique list and add the CriteriaRange
-
Set ws2 = Worksheets.Add
-
-
With ws2
-
'first we copy the Unique data from the filter field to ws2
-
My_Range.Columns(FieldNum).AdvancedFilter _
-
Action:=xlFilterCopy, _
-
CopyToRange:=.Range("A1"), Unique:=True
-
-
'loop through the unique list in ws2 and filter/copy to a new sheet
-
Lrow = .Cells(Rows.Count, "A").End(xlUp).Row
-
For Each cell In .Range("A2:A" & Lrow)
-
-
'Filter the range
-
My_Range.AutoFilter Field:=FieldNum, Criteria1:="=" & _
-
Replace(Replace(Replace(cell.Value, "~", "~~"), "*", "~*"), "?", "~?")
-
-
'Check if there are no more then 8192 areas(limit of areas)
-
CCount = 0
-
On Error Resume Next
-
CCount = My_Range.Columns(1).SpecialCells(xlCellTypeVisible) _
-
.Areas(1).Cells.Count
-
On Error GoTo 0
-
If CCount = 0 Then
-
MsgBox "There are more than 8192 areas for the value : " & cell.Value _
-
& vbNewLine & "It is not possible to copy the visible data." _
-
& vbNewLine & "Tip: Sort your data before you use this macro.", _
-
vbOKOnly, "Split in worksheets"
-
Else
-
'Add a new worksheet
-
Set WSNew = Worksheets.Add(After:=Sheets(Sheets.Count))
-
On Error Resume Next
-
WSNew.Name = cell.Value
-
If Err.Number > 0 Then
-
ErrNum = ErrNum + 1
-
WSNew.Name = "Error_" & Format(ErrNum, "0000")
-
Err.Clear
-
End If
-
On Error GoTo 0
-
-
'Copy the visible data to the new worksheet
-
My_Range.SpecialCells(xlCellTypeVisible).Copy
-
With WSNew.Range("A1")
-
' Paste:=8 will copy the columnwidth in Excel 2000 and higher
-
' Remove this line if you use Excel 97
-
.PasteSpecial Paste:=8
-
.PasteSpecial xlPasteValues
-
.PasteSpecial xlPasteFormats
-
Application.CutCopyMode = False
-
.Select
-
End With
-
End If
-
-
'Show all data in the range
-
My_Range.AutoFilter Field:=FieldNum
-
-
Next cell
-
-
'Delete the ws2 sheet
-
On Error Resume Next
-
Application.DisplayAlerts = False
-
.Delete
-
Application.DisplayAlerts = True
-
On Error GoTo 0
-
-
End With
-
-
'Turn off AutoFilter
-
My_Range.Parent.AutoFilterMode = False
-
-
If ErrNum > 0 Then
-
MsgBox "Rename every WorkSheet name that start with ""Error_"" manually" _
-
& vbNewLine & "There are characters in the name that are not allowed" _
-
& vbNewLine & "in a sheet name or the worksheet already exist."
-
End If
-
-
'Restore ScreenUpdating, Calculation, EnableEvents, ....
-
My_Range.Parent.Select
-
ActiveWindow.View = ViewMode
-
With Application
-
.ScreenUpdating = True
-
.EnableEvents = True
-
.Calculation = CalcMode
-
End With
-
-
End Sub
-
-
1 1742
Duh. I figured it out. You can't have more than 31 characters/spaces in a worksheet name.
Sign in to post your reply or Sign up for a free account.
Similar topics |
by: steve |
last post by:
To gain performance, do I need to index ALL the fields in the where
clause.
Say we have a query like:
select stuff from table where field1=.. and field2=...
If field1 selection substantially...
|
by: Terry |
last post by:
Problem:
=========
Unknown column appearing in federated tables.
Description:
============
Local database (L) is an established 'federated' database, extracting
values from multiple remote...
|
by: Matt |
last post by:
Have below code
AcctNbr give me result of 30.
That is the database column length, Column stores 10 why is giving me
30 ?
while(objRead.Read())
{
AcctNbr = (string)objRead.ToString().Length;...
|
by: Alan Silver |
last post by:
Hello,
Sorry if this is covered somewhere, but I've looked at countless sites
explaining how to do multicolumn layouts in CSS, but have yet to find
one that does what I want.
In the old days,...
|
by: ntuyen01 |
last post by:
Hi All,
I have this data file with fix length(see below). I am able to insert
it into the database using bcp, but now I want to skip (do not insert)
the row which start with letter 'S' into the...
| |
by: Humppatirallaa |
last post by:
So, the problem is that I query data out of a ntext (variable length
Unicode text) field, and it is corrupted near the end.
Yes, I know that the misfeatures odbc.defaultlrl and...
|
by: Sarita |
last post by:
Hello,
this might sound stupid, but I got a really nice homepage template
which unfortunately is a 3-Column Fixed Width CSS format. Now I don't
have any content for the right column and would...
|
by: =?iso-8859-2?Q?Marcin_Dzi=F3bek?= |
last post by:
Hi All:
I need to get (filter in) some dataview's rows with DBNULLs in column of boolean type:
Actually to get the only rows with DBNULL, I use code like this:
DV.RowFilter =...
|
by: bsathishmca |
last post by:
Hi Guiders,
I need to check the whether space is there in verchar column or not.
select a.mycol1,a.mycol2 from mytable a where (decode(length(a.mycol1),length(rtrim(a.mycol1)),'No') is NULL...
|
by: WyvsEyeView |
last post by:
I have a datasheet form in which one field is a combo box that will potentially contain hundreds of records. I've read about several methods of speeding up such combo boxes or limiting their initial...
|
by: Oralloy |
last post by:
Hello folks,
I am unable to find appropriate documentation on the type promotion of bit-fields when using the generalised comparison operator "<=>".
The problem is that using the GNU compilers,...
| |
by: jinu1996 |
last post by:
In today's digital age, having a compelling online presence is paramount for businesses aiming to thrive in a competitive landscape. At the heart of this digital strategy lies an intricately woven...
|
by: Hystou |
last post by:
Overview:
Windows 11 and 10 have less user interface control over operating system update behaviour than previous versions of Windows. In Windows 11 and 10, there is no way to turn off the Windows...
|
by: tracyyun |
last post by:
Dear forum friends,
With the development of smart home technology, a variety of wireless communication protocols have appeared on the market, such as Zigbee, Z-Wave, Wi-Fi, Bluetooth, etc. Each...
|
by: agi2029 |
last post by:
Let's talk about the concept of autonomous AI software engineers and no-code agents. These AIs are designed to manage the entire lifecycle of a software development project—planning, coding, testing,...
|
by: isladogs |
last post by:
The next Access Europe User Group meeting will be on Wednesday 1 May 2024 starting at 18:00 UK time (6PM UTC+1) and finishing by 19:30 (7.30PM).
In this session, we are pleased to welcome a new...
|
by: TSSRALBI |
last post by:
Hello
I'm a network technician in training and I need your help.
I am currently learning how to create and manage the different types of VPNs and I have a question about LAN-to-LAN VPNs.
The...
| |
by: adsilva |
last post by:
A Windows Forms form does not have the event Unload, like VB6. What one acts like?
|
by: 6302768590 |
last post by:
Hai team
i want code for transfer the data from one system to another through IP address by using C# our system has to for every 5mins then we have to update the data what the data is updated ...
| |