none
VBA - Showing text from two different cells into one cell RRS feed

  • Question

  • Hi,

    I have a worksheet (Sheet1) which contains data spread around the sheet. I made a VBA code which can search into this sheet to a specific text ("text") and retrieve certain information to a second sheet (Sheet2).

    Now, the code I have now works:

    Dim ra As Range Set wb = ThisWorkbook

    Set ra = wb.Sheets(1).Cells.Find(What:="text", LookIn:=xlFormulas, LookAt _ :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _ False, SearchFormat:=False) If ra Is Nothing Then MsgBox("Not Found") Else Row = ra.Cells.Row Column = ra.Cells.Column Last = wb.Sheets(1).Cells(Row, Column).End(xlDown).Row For x = Row + 1 To Last wb.Worksheets(1).Range(wb.Worksheets(1).Cells(Row + 1, Column), wb.Worksheets(1).Cells(Last, Column)).Copy wb.Sheets("Sheet2").Paste Destination:=Sheets("Sheet2").Rows(1).Columns(1) Next End If

    (There are multiple sheets, but I edited this code so it only applies for Sheet1).

    The Result now is:

    So this works, but when I have two cells with data like given in this example:

    The output will be:

    I understand that this happens, it's a normal behaviour of the code. However, I want to have the text pasted here into one cell only. For example:

    Some other way is also fine, as long all the data is added in one cell, and that I can read it normally.

    Does someone know how to do this?

    Thanks in advance.

    Ganesh

    Thursday, March 22, 2018 4:47 PM

Answers

  • Try this version:

        Dim ra As Range
        Dim s As String
    
        Set wb = ThisWorkbook
        Set ra = wb.Sheets(1).Cells.Find(What:="text", LookIn:=xlFormulas, LookAt _
            :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
            False, SearchFormat:=False)
        If ra Is Nothing Then
            MsgBox ("Not Found")
        Else
            Row = ra.Cells.Row
            Column = ra.Cells.Column
            Last = wb.Sheets(1).Cells(Row, Column).End(xlDown).Row
            For x = Row + 1 To Last
                s = s & ", " & wb.Worksheets(1).Cells(x, Column).Text
            Next x
            If s <> "" Then
                wb.Sheets("Sheet2").Range("A1").Value = Mid(s, 3)
            End If
        End If


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Thursday, March 22, 2018 4:59 PM