ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Split up or delineate data (https://www.excelbanter.com/excel-programming/455041-split-up-delineate-data.html)

Tatsujin February 1st 21 09:31 AM

Split up or delineate data
 
I have a column of data similar to this:

ant
antique
art
bee
beautiful
bored
chores
dancing
daytime

Does Excel have any means of finding the rows where the first letter of the alphabet changes to a new letter, and insert a new row in between such as this:

----A----
ant
antique
art
----B----
bee
beautiful
bored
----C----
chores
----D---
dancing
daytime

etc. etc... I'm pretty much trying to insert letter headers above the start of each new letter series.

If not, what if I store the same sorted list of values in an array of strings? What would be a good way of creating a new array that inserts letter dividers similar to above?


Claus Busch February 1st 21 09:50 AM

Split up or delineate data
 
Hi,

Am Mon, 1 Feb 2021 01:31:17 -0800 (PST) schrieb Tatsujin:

I have a column of data similar to this:

ant
antique
art
bee
beautiful
bored
chores
dancing
daytime

Does Excel have any means of finding the rows where the first letter of the alphabet changes to a new letter, and insert a new row in between such as this:

----A----
ant
antique
art
----B----
bee
beautiful
bored
----C----
chores
----D---
dancing
daytime

etc. etc... I'm pretty much trying to insert letter headers above the start of each new letter series.


if your values are in column A then try:

Sub Test()
Dim LRow As Long, i As Long
Dim myStr As String

With ActiveSheet
LRow = .Cells(.Rows.Count, 1).End(xlUp).Row
For i = LRow To 2 Step -1
If Left(.Cells(i, 1), 1) < Left(.Cells(i - 1, 1), 1) Then
myStr = "---" & UCase(Left(.Cells(i, 1), 1)) & "---"
.Rows(i).Insert
.Cells(i, 1) = myStr
End If
Next
.Rows(1).Insert
.Cells(1, 1) = "---" & UCase(Left(.Cells(2, 1), 1)) & "---"
End With
End Sub

Otherwise change the references.


Regards
Claus B.
--
Windows10
Microsoft 365 for business

Tatsujin February 1st 21 10:21 AM

Split up or delineate data
 

Wow, that is amazing!

I also wanted to find a solution where the data only existed in an array of strings or a variant, but I could probably just transfer the array to a spreadsheet column and run your code.

Thanks for your expertise!

Claus Busch February 1st 21 11:11 AM

Split up or delineate data
 
Hi,

Am Mon, 1 Feb 2021 02:21:00 -0800 (PST) schrieb Tatsujin:

I also wanted to find a solution where the data only existed in an array of strings or a variant, but I could probably just transfer the array to a spreadsheet column and run your code.


try:

Dim myStr As String
Dim varData As Variant

myStr = "ant,antique,art,bee,beautiful,bored,chores,dancin g,daytime"
varData = Split(myStr, ",")
Range("A1").Resize(UBound(varData) + 1) = Application.Transpose(varData)


Regards
Claus B.
--
Windows10
Microsoft 365 for business

Tatsujin February 1st 21 08:11 PM

Split up or delineate data
 
try:

Dim myStr As String
Dim varData As Variant

myStr = "ant,antique,art,bee,beautiful,bored,chores,dancin g,daytime"
varData = Split(myStr, ",")
Range("A1").Resize(UBound(varData) + 1) = Application.Transpose(varData)

That basically just copied the string into column A. What I meant was, I was also thinking about a solution that doesn't involve spreadsheet cells.

For example, if

myStr = "ant,antique,art,bee,beautiful,bored,chores,dancin g,daytime"

then the output should be:

myStr2 = "--A--,ant,antique,art,--B--,bee, etc.."

But, I'm happy with your initial solution.

Thanks!

Claus Busch February 1st 21 09:05 PM

Split up or delineate data
 
Hi,

Am Mon, 1 Feb 2021 12:11:05 -0800 (PST) schrieb Tatsujin:

For example, if

myStr = "ant,antique,art,bee,beautiful,bored,chores,dancin g,daytime"

then the output should be:

myStr2 = "--A--,ant,antique,art,--B--,bee, etc.."


then try:

Sub Test()
Dim myStr As String
Dim varData() As Variant
Dim re, match, matches, ptrn
Dim n As Long, i As Long

Set re = CreateObject("vbscript.regexp")
ptrn = "\w+"

myStr = "ant,antique,art,bee,beautiful,bored,chores,dancin g,daytime"
re.pattern = ptrn
re.IgnoreCase = False
re.Global = True
Set matches = re.Execute(myStr)
ReDim Preserve varData(n)
varData(n) = "---" & UCase(Left(matches(1), 1)) & "---"
n = n + 1
For i = 0 To matches.Count - 2
ReDim Preserve varData(n)
If Left(matches(i + 1), 1) = Left(matches(i), 1) Then
varData(n) = matches(i)
n = n + 1
Else
varData(n) = matches(i)
n = n + 1
ReDim Preserve varData(n)
varData(n) = "---" & UCase(Left(matches(i + 1), 1)) & "---"
n = n + 1
End If
Next
ReDim Preserve varData(n)
varData(n) = matches(matches.Count - 1)
myStr = Join(varData, ", ")
Range("A1") = myStr
End Sub


Regards
Claus B.
--
Windows10
Microsoft 365 for business


All times are GMT +1. The time now is 01:12 PM.

Powered by vBulletin® Copyright ©2000 - 2021, Jelsoft Enterprises Ltd.
ExcelBanter.com