How to create VBA to split data to their respective columns with character restriction
Category: [Excel] Demo Available
How to create VBA to split data to their respective columns with character restriction
Requirement:
The user received merged description that need to be break into three fields.The columns are then uploaded as csv format
Columns A represent the merge description that need to be broken into their respective columns but the issue come from column C,where characters are limited to 32 characters.(red )
The user wants to break down column C into two columns parts.
Expected results are in yellow.
Formulas used in column B, C and D but when column C is more 32 characters, the user needs to cut and paste manually which is painful with 10000 rows of data daily.
Solution:
Code:
Option Explicit
Sub Split_And_Save_As_CSVTT()
Dim x, y(), z, s, i As Long, ii As Long, iii As Integer
Dim sPath As String, sFileName As String, sFullName As String
sFileName = "Name of CSV File" '// Change name of CSV file to suit
sPath = ThisWorkbook.Path '// Change to required path if not same as this workbook
If Right(sPath, 1) <> Application.PathSeparator Then
sFullName = sPath & Application.PathSeparator & sFileName & ".csv"
Else
sFullName = sPath & sFileName & ".csv"
End If
x = Sheets("break ").UsedRange.Columns(1)
ReDim y(1 To UBound(x, 1) - 1, 3)
For i = 2 To UBound(x, 1)
z = Split(x(i, 1))
y(i - 1, 0) = z(0)
For ii = 1 To UBound(z) - 2
If ii = 1 Then
y(i - 1, 1) = z(ii)
Else
y(i - 1, 1) = y(i - 1, 1) & " " & z(ii)
End If
Next
If Len(y(i - 1, 1)) > 32 Then
If InStr(y(i - 1, 1), "(") > 0 Then
s = Split(y(i - 1, 1), ")")
y(i - 1, 1) = Trim(s(0)) & ")"
y(i - 1, 2) = Trim(s(1))
If Len(y(i - 1, 1)) > 32 Then
s = Split(y(i - 1, 1), "(")
y(i - 1, 1) = Trim(s(0))
If y(i - 1, 2) = "" Then
y(i - 1, 2) = "(" & Trim(s(1))
Else
y(i - 1, 2) = "(" & Trim(s(1)) & " " & y(i - 1, 2)
End If
End If
Else
s = Split(y(i - 1, 1))
y(i - 1, 1) = ""
For ii = 0 To UBound(s)
If Len(y(i - 1, 1)) + Len(s(ii)) < 33 Then
If ii = 0 Then
y(i - 1, 1) = s(ii)
Else
y(i - 1, 1) = y(i - 1, 1) & " " & s(ii)
End If
Else
If y(i - 1, 2) = "" Then
y(i - 1, 2) = s(ii)
Else
y(i - 1, 2) = y(i - 1, 2) & " " & s(ii)
End If
End If
Next
End If
End If
y(i - 1, 3) = z(UBound(z) - 1)
Next
Application.ScreenUpdating = 0
With Sheets("Split_Data")
.UsedRange.Offset(1).Clear
.[a2].Resize(UBound(y, 1), 4) = y
.Columns.AutoFit
Application.DisplayAlerts = False
.Copy
ActiveWorkbook.SaveAs sFullName, 6
ActiveWorkbook.Close
Application.DisplayAlerts = True
End With
End Sub
Obtained from the OzGrid Help Forum.
Solution provided by KjBox.
See also: Index to Excel VBA Code and Index to Excel Freebies and Lesson 1 - Excel Fundamentals and Index to how to… providing a range of solutions and Index to new resources and reference sheets
See also:
| How to extract text from a string before a last specified character |
| How to extract characters |
| How to remove the last X number of characters depending on the ending of the value |
| How to create a custom function to extract integers from a simple 11 character string |
Click here to visit our Free 24/7 Excel/VBA Help Forum where there are thousands of posts you can get information from, or you can join the Forum and post your own questions.