VBA script to Concatenate data with a defined first text string and end string.

[FlyingSchmidt]

Looking for help to create a script that will automatically concatenate data when pasted into my workbook.
Unfortunately the data I am working with can only be copied from a webpage and not exported into a .csv.
The below screen capture shows how the data gets pasted into excel from the website.
Each string begins with character an exclamation mark "!" and ends with a 10 digit time group.
There are empty cells between each single set of data. The data strings that need to be concatenated are not separated by empty cells.
Any help would be greatly appreciated.

 

[Joe4]

Welcome to the Board!

Can you post what your expected results should look like?
Do you still want the blanks left between items?

 

[FlyingSchmidt]

Welcome to the Board!

Can you post what your expected results should look like?
Do you still want the blanks left between items?

Hi Joe,
The raw data I receive on the left and the format I require on the right. I do not want/need the blank cells between the data.
Thanks for the help.

 

[JEC]

This should work

Sub jec()
 Dim ar As Variant, i As Long, x As Long
 Dim sq() As Variant
 ar = Range("A1", Range("A" & Rows.Count).End(xlUp))
 
 For i = 1 To UBound(ar)
     ReDim Preserve sq(x)
     If i = 1 Then
       sq(x) = ar(i, 1)
     ElseIf Len(ar(i - 1, 1)) = 0 Or Len(ar(i, 1)) = 0 Then
       sq(x) = ar(i, 1)
     Else
       sq(x - 1) = sq(x - 1) & " " & ar(i, 1)
       x = x - 1
     End If
     x = x + 1
 Next
 
 With Range("A1", Range("A" & Rows.Count).End(xlUp))
   .ClearContents
   .Resize(x) = Application.Transpose(sq)
 End With
End Sub

 

[FlyingSchmidt]

This should work

Sub jec()
 Dim ar As Variant, i As Long, x As Long
 Dim sq() As Variant
 ar = Range("A1", Range("A" & Rows.Count).End(xlUp))
 
 For i = 1 To UBound(ar)
     ReDim Preserve sq(x)
     If i = 1 Then
       sq(x) = ar(i, 1)
     ElseIf Len(ar(i - 1, 1)) = 0 Or Len(ar(i, 1)) = 0 Then
       sq(x) = ar(i, 1)
     Else
       sq(x - 1) = sq(x - 1) & " " & ar(i, 1)
       x = x - 1
     End If
     x = x + 1
 Next
 
 With Range("A1", Range("A" & Rows.Count).End(xlUp))
   .ClearContents
   .Resize(x) = Application.Transpose(sq)
 End With
End Sub

Could not get this one to work

 

[Peter_SSs]

Welcome to the MrExcel board!

For the future, consider this so that helpers do have to amnually type data to test with:
MrExcel has a tool called “XL2BB” that lets you post samples of your data that will allow us to copy/paste it to our Excel spreadsheets, so we can work with the same copy of data that you are. Instructions on using this tool can be found here: XL2BB Add-in

Note that there is also a "Test Here” forum on this board. This is a place where you can test using this tool (or any other posting techniques that you want to test) before trying to use those tools in your actual posts.


Try this with a copy of your data.

If you want to remove all the blank lines from the results, uncomment the line near the end of the code

Sub Join_Data()
  Dim rA As Range
  
  Application.ScreenUpdating = False
  For Each rA In Range("A1", Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlConstants).Areas
    With rA
      If .Rows.Count > 1 Then
        .Cells(1).Value = Join(Application.Transpose(.Value))
        .Offset(1).ClearContents
      End If
    End With
  Next rA
'  Columns("A").SpecialCells(xlBlanks).Delete Shift:=xlUp
  Application.ScreenUpdating = True
End Sub

Before:

FlyingSchmidt.xlsm
	A
1	chsaf s g fhg
2
3	czCZC
4
5	zczCv cvbvcbnvb
6	vcbnmvbmvn
7
8	vbnmbvm
9	aaaaaa
10	mhmhm
11
12
13	sfdsdf
Sheet1

After:

FlyingSchmidt.xlsm
	A
1	chsaf s g fhg
2
3	czCZC
4
5	zczCv cvbvcbnvb vcbnmvbmvn
6
7
8	vbnmbvm aaaaaa mhmhm
9
10
11
12
13	sfdsdf
Sheet1

 

[FlyingSchmidt]

Thank you Peter!
This works for my needs very well.
I will try to get the XL2BB Add-in next time. I was having issues with admin rights on my work computer.

Again, many thanks

 

[Peter_SSs]

You're welcome. Thanks for the follow-up.

Hope that you can get XL2BB up and running in due course. ?