Combining rows 3 through 7 into row 2, one row takes a painfully long time with this code. Why?

[chazrab]

As stated in title, this code block
1) finds any value using FIND,
2) copies it to row 2 of Sheet2, and the next 6 rows below it to a blank sheet and
3) combines all the rows below row 2 into row 2.
4) and will display the results of the combined row in Textbox1 of Userform1.
It was a challenge, that I managed to make work, but is painfully slow in calculating.

From a button:
Private Sub cmdFIND_Click()
Sheets("BIBLESTUDY").Range("A2:E20").ClearContents
Dim LastRow As Integer, x As String, c As Range, rw As Long
          x = ComboBox1.Value
           LastRow = Sheets("BIBLESTUDY").Range("A" & rows.count).End(xlUp).Row
                 With Worksheets("Sheet2").Range("B1:B31103")
                          Set c = .FIND(x, LookIn:=xlValues, Lookat:=xlPart, MatchCase:=False, SearchFormat:=False)
                            If Not c Is Nothing Then
                             Worksheets("Sheet2").Select
                                c.Select
                                         If LastRow = 1 Then
                                             Range(Cells(c.Row + 5, 2), Cells(c.Row, 3)).Copy Destination:=Sheets("BIBLESTUDY").Range("A" & LastRow + 1)
                                        Else
                                              Worksheets("Sheet2").Select
                                               c.Select
                                             Range(Cells(c.Row + 5, 2), Cells(c.Row, 3)).Copy Destination:=Sheets("BIBLESTUDY").Range("A" & LastRow + 1)
                                        End If
                             Else
                                   MsgBox "value not found"
                            End If
                     End With
                     TextBox1 = Sheets("BIBLESTUDY").Range("B2") _
                      & vbCrLf & Sheets("BIBLESTUDY").Range("B3") _
                      & vbCrLf & Sheets("BIBLESTUDY").Range("B4") _
                      & vbCrLf & Sheets("BIBLESTUDY").Range("B5") _
                      & vbCrLf & Sheets("BIBLESTUDY").Range("B6") _
'
                     TextBox4 = Sheets("BIBLESTUDY").Range("C2") _
                      & vbCrLf & Sheets("BIBLESTUDY").Range("C3") _
                      & vbCrLf & Sheets("BIBLESTUDY").Range("C4") _
                      & vbCrLf & Sheets("BIBLESTUDY").Range("C5") _
                      & vbCrLf & Sheets("BIBLESTUDY").Range("C6") _
                    
                     'This code block below seems to be the slow wheel on the gear turn:  (AKA this is what I think is making it take a ong time)                 
                     Dim ws As Worksheet, LastRow2, i As Long
                    Set ws = ThisWorkbook.Sheets("BIBLESTUDY")
                    LastRow2 = ws.Cells(ws.rows.count, 1).End(xlUp).Row + 1
                    For i = 2 To LastRow2
                    ws.Cells(2, i).Value = ws.Cells(2, i).Value _
                    & vbCrLf & ws.Cells(3, i).Value _
                    & vbCrLf & ws.Cells(4, i).Value _
                    & vbCrLf & ws.Cells(5, i).Value _
                    & vbCrLf & ws.Cells(6, i).Value _
                    & vbCrLf & ws.Cells(7, i).Value _

                    Next i
                    Worksheets("BIBLESTUDY").rows(3 & ":" & Worksheets("BIBLESTUDY").rows.count).Delete
    Dim LastEmpty, LastRow3 As Long
    LastEmpty = Sheets("BIBLESTUDY").Cells(rows.count, "A").End(xlUp).Row
    LastRow3 = Worksheets("BIBLESTUDYALL").Range("A" & rows.count).End(xlUp).Row + 1
     MsgBox "LastEmpty row is" & "  " & LastEmpty & "   " & "LastRow3 row is" & "  " & LastRow3
     Sheets("BIBLESTUDY").Range("A2:F2" & LastEmpty).Copy Destination:=Sheets("BIBLESTUDYALL").Range("A" & LastRow3)
   
The concanetnaton or combining process ends here.  it does give the correct of putting all rows below row 2 into row 2  but takes forever.
     End Sub

Yes - this is a lot of code to look at and I don't like posting long code blocks - unless it reveals a better, faster, more efficient way.

The simple bottom line is, is there any faster more efficient way to combine 6 or 7 rows below row 2 into row 2 and copy that to another sheet?

Images show the result. Last image is the code that does the combining - and slows the process down.

A lot of stluff. Any help would be greatly appreciated.
cr

 

[Alex Blakenburg]

In the code below, why are using a row counter (i / LastRow2) in the column position ?

                    Set ws = ThisWorkbook.Sheets("BIBLESTUDY")
                    LastRow2 = ws.Cells(ws.rows.count, 1).End(xlUp).Row + 1
                    For i = 2 To LastRow2
                       ws.Cells(2, i).Value = ws.Cells(2, i).Value _
                       & vbCrLf & ws.Cells(3, i).Value _
                       & vbCrLf & ws.Cells(4, i).Value _
                       & vbCrLf & ws.Cells(5, i).Value _
                       & vbCrLf & ws.Cells(6, i).Value _
                       & vbCrLf & ws.Cells(7, i).Value _
                    Next i

I would have expected something more like this:

    Dim sConcat As String
    sConcat = ws.Cells(2, 2).Value
    For i = 3 To LastRow2
        sConcat = sConcat & vbCrLf & ws.Cells(i, 2).Value
    Next i
    ws.Cells(2, 2).Value = sConcat

 

[jolivanes]

Maybe

Dim lr As Long
Dim joined As String
lr = Cells(Rows.Count, 2).End(xlUp).Row
joined = Join(Application.Transpose(Range("B2:B" & lr)), vbLf)
Cells(2, 2) = joined