j_saints
New Member
- Joined
- Sep 21, 2020
- Messages
- 8
- Office Version
- 365
- 2019
- 2016
- 2013
- 2011
- 2010
- 2007
- Platform
- Windows
Hello,
I have a macro that helps me with timesheet organization - it parses data by column and creates tabs based on company names (Column A)
However if it's greater than 31 characters it just doesn't create the tab which is causing an issue. I have to go over and check which companies did not push through. Can someone please help me bypass this? Ideally, what I want to achieve is if the company name has over 31 character, the script would ignore that and continue to parse data and generate tabs. It wouldn't really matter if the tab name would just show 31 characters as an end result but if there's a way to expand it, would be great too. Here's the script that I use below:
Any help would be greatly appreciated!
I have a macro that helps me with timesheet organization - it parses data by column and creates tabs based on company names (Column A)
However if it's greater than 31 characters it just doesn't create the tab which is causing an issue. I have to go over and check which companies did not push through. Can someone please help me bypass this? Ideally, what I want to achieve is if the company name has over 31 character, the script would ignore that and continue to parse data and generate tabs. It wouldn't really matter if the tab name would just show 31 characters as an end result but if there's a way to expand it, would be great too. Here's the script that I use below:
VBA Code:
Sub parse_data()
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
'This macro splits data into multiple worksheets based on the variables on a column found in Excel.
'An InputBox asks you which columns you'd like to filter by, and it just creates these worksheets.
Application.ScreenUpdating = False
vcol = Application.InputBox(prompt:="Which column would you like to filter by?", title:="Filter column", Default:="3", Type:=1)
Set ws = ActiveSheet
lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
title = "A1"
titlerow = ws.Range(title).Cells(1).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
Application.ScreenUpdating = True
End Sub
Any help would be greatly appreciated!