CONCATENATE

[vmjan02]

I have the code and is all perfect on if the data is in col e and f, bus as per the table the data will start for E and end to AA, so ned to modify the code to get the right output

Book2
	B	C	D	E	F	G	H	I	J
1	Actual Bundle Ether		OutPut
2	BE10		Gi101/0/0/4 ; Gi102/0/0/4	Gi101/0/0/4 Local Configured 0x8000	Gi102/0/0/4 Local Active 0x8000
3	BE40		Gi101/0/0/13	Gi101/0/0/13 Local Active 0x8000
4	BE50		Te0/2/0/3 ; Te0/3/0/3	Te0/2/0/3 Local Active 0x8000	Te0/3/0/3 Local Active 0x8000
5	BE101		Te0/3/0/9	Te0/3/0/9 Local Active 0x8000
6	BE110		Gi100/0/0/25 ; Gi101/0/0/25	Gi100/0/0/25 Local Active 0x8000	Gi101/0/0/25 Local Active 0x8000
7	BE120		Gi100/0/0/24 ; Gi101/0/0/24	Gi100/0/0/24 Local Active 0x8000	Gi101/0/0/24 Local Active 0x8000
8	BE130		Gi100/0/0/27	Gi100/0/0/27 Local Active 0x8000
9	BE1000		Te0/2/0/18 ; Te0/2/0/19 ; Te0/3/0/18 ; Te0/3/0/19	Te0/2/0/18 Local Active 0x8000	Te0/2/0/19 Local Active 0x8000	Te0/3/0/18 Local Active 0x8000	Te0/3/0/19 Local Active 0x8000
10	BE10		Te0/0/0/6 ; Te0/1/0/6	Te0/0/0/6 Local Active 0x8000	Te0/1/0/6 Local Active 0x8000
11	BE20		Te0/0/0/5 ; Te0/1/0/5	Te0/0/0/5 Local Active 0x8000	Te0/1/0/5 Local Standby 0x8000
12	BE40		Te0/0/0/12 ; Te0/0/1/4 ; Te0/1/0/12 ; Te0/1/1/4	Te0/0/0/12 Local Active 0x8000	Te0/0/1/4 Local Active 0x8000	Te0/1/0/12 Local Active 0x8000	Te0/1/1/4 Local Active 0x8000
13	BE500		Te0/0/0/11 ; Te0/1/0/11 ; Te0/2/0/3 ; Te0/2/0/11 ; Te0/3/0/3 ; Te0/3/0/11	Te0/0/0/11 Local Active 0x8000	Te0/1/0/11 Local Active 0x8000	Te0/2/0/3 Local Active 0x8000	Te0/2/0/11 Local Active 0x8000	Te0/3/0/3 Local Active 0x8000	Te0/3/0/11 Local Active 0x8000
Sheet1

It works only for E and F columns, need to en till the last non blank cells in column B

Sub ExtractAndCombineperfect()


    ' Get values from E2 and F2
    Dim valueE As String
    Dim valueF As String

    valueE = Range("E2").Value
    valueF = Range("F2").Value

    ' Take the first 14 characters from each value
    Dim truncatedValueE As String
    Dim truncatedValueF As String

    truncatedValueE = Left(valueE, 14)
    truncatedValueF = Left(valueF, 14)

    ' Combine truncated values with a semicolon and put the result in G2
    Range("D2").Value = Application.WorksheetFunction.Trim(truncatedValueE & ";" & truncatedValueF)
End Sub

 

[RobP]

Thanks for pointing out (it looks like it to the eye, but I can't find a space in my cut and pasted data)

Anyway, I'll let the OP comment and see if what we have here is fitting their needs before proceeding further..

cheers
Rob

 

[Fluff]

Did you use the copy icon just above the row numbers?

 

[vmjan02]

Sub test() For Row_num = 2 To ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row ' find the last row of data in Col B For Col_no = 5 To 27 '(count from Col E to Col AA) If Cells(Row_num, Col_no) = "" Then Exit For 'go to next row if col is empty (to save time) mydata = mydata & Left(Cells(Row_num, Col_no), InStr(Cells(Row_num, Col_no), " ")) & " ; " Next Col_no Range("D" & Row_num).Value = mydata mydata = "" 'reset mydata to blank for next row Next Row_num End Sub

I have run this code but not giving correct output, in coumn D

 

[RobP]

@Fluff ... LOVE that button . I've never noticed it before .. every day a school day ..

Try this version then :

Sub test()

For Row_num = 2 To ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row ' find the last row of data in Col B

    For Col_no = 5 To 27  '(count from Col E to Col AA)
        
        If Cells(Row_num, Col_no) = "" Then Exit For  'go to next row if col is empty (to save time)
            tempdata = Right(Cells(Row_num, Col_no), Len(Cells(Row_num, Col_no)) - 2)
            mydata = mydata & Left(tempdata, InStr(tempdata, " ")) & "; "
    
    Next Col_no
    
    Range("D" & Row_num).Value = Left(mydata, Len(mydata) - 3)
    tempdata = "" 'reset temp & mydata to blank for next row
    mydata = ""
    
Next Row_num

End Sub

 

[vmjan02]

Sub test() For Row_num = 2 To ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row ' find the last row of data in Col B For Col_no = 5 To 27 '(count from Col E to Col AA) If Cells(Row_num, Col_no) = "" Then Exit For 'go to next row if col is empty (to save time) tempdata = Right(Cells(Row_num, Col_no), Len(Cells(Row_num, Col_no)) - 2) mydata = mydata & Left(tempdata, InStr(tempdata, " ")) & "; " Next Col_no Range("D" & Row_num).Value = Left(mydata, Len(mydata) - 3) tempdata = "" 'reset temp & mydata to blank for next row mydata = "" Next Row_num End Sub

@RobP

Thnak you for quick response, but it have stop here (ref screen shot) and error on line

Range("D" & Row_num).Value = Left(mydata, Len(mydata) - 3)  'Run Time Error 5

so moditied a bit, hope i did the right think, rest the output is correct, pleae advice

[B]On Error Resume Next[/B]
    Range("D" & Row_num).Value = Left(mydata, Len(mydata) - 3)

 

[RobP]

thanks for feedback - indeed hard to know why its stopped, as we cannot see your actual data there from each cell. The caveat here in my code is that it assumes there is always 2 " " spaces before your data, hence starts to look from char 3. Maybe that data is slightly different there in that row ? (ah, I see you have blank rows in your data .. and I have no error trapping..)_

anyway, if you have made it work for you - then thats good ..

cheers
Rob

 

[RustamMika]

Fluff​

replace to dictionary..

Sub ExtractAndCombineperfect()
    Set abc = CreateObject("Scripting.Dictionary")
    For i = 2 To Cells(Rows.Count, 2).End(xlUp).Row
        For j = 5 To Cells(i, Columns.Count).End(xlToLeft).Column
            dict.Add CStr(Split(Cells(i, j))(0)), j
        Next
     Cells(i, 4).Value = Join(abc.keys, ";")
    Next
End Sub

 

[RustamMika]

The OP's data has spaces at the start of the each string so your code is effectively LEFT(cell,1)

eazy to split string with space separator and take 1st element of created array

 

[RustamMika]

Split(Cells(i, j))(0)

 

[Fluff]

eazy to split string with space separator and take 1st element of created array

Except that still won't work. Did you test it?