Ufdjrw

I am trying to identify a specific range in column-A and concatenate two cells within the specific range and delete the empty cell. I have been successful in putting a code together and it does the job very well. But, I don't know how to loop it to identify next range. Any help would be appreciated.

As per below image and code, First, I am finding and selecting a range between two (MCS) in column-A with a condition that, if the rows are more than 8 between two MCS. Then I am concatenating first 2 cells immediately after MCS and delete the empty row.

The below code works well for first range but I am unable to loop to identify next range from row 22 to 32 and perform concatenations. I want to loop in column-A as there will be more MCS.

Sub MergeStem()
 Dim findMCS1 As Long
 Dim findMCS2 As Long
 Dim myCount As Integer
 Dim myStems As Long
 Dim mySelect As Range
 Dim c As Range

 findMCS1 = Range("A:A").Find("MCS", Range("A1")).Row
 findMCS2 = Range("A:A").Find("MCS", Range("A" & findMCS1)).Row

 myCount = Range("A" & findMCS1 + 1 & ":A" & findMCS2 - 1).Cells.Count
 Range("B1").Value = myCount
 MsgBox "Number of rows =" & myCount

 Set mySelect = Selection

 If myCount > 8 Then
 myStems = Range("A" & findMCS1 + 2 & ":A" & findMCS2 - 9).Select

 Set mySelect = Selection

 For Each c In mySelect.Cells
 If firstcell = "" Then firstcell = c.Address(bRow, bCol)
 sArgs = sArgs + c.Text + " "

 c.Value = ""
 Next
 Range(firstcell).Value = sArgs
 End If

 Columns("A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

 Application.ScreenUpdating = True

End Sub

You could try:

Option Explicit

Sub test()

 Dim i As Long, Lastrow As Long, Startpoint As Long, Endpoint As Long, Diff As Long
 Dim str As String

 With ThisWorkbook.Worksheets("Sheet1")

 Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row

 Startpoint = 0
 Endpoint = 0

 For i = Lastrow To 2 Step -1

 str = .Range("A" & i).Value

 If str = "MCS" And Startpoint = 0 Then
 Startpoint = i
 ElseIf str = "MCS" And Startpoint <> 0 Then
 Endpoint = i
 End If

 If Startpoint > 0 And Endpoint > 0 Then

 Diff = Startpoint - Endpoint

 If Diff > 8 Then

 .Range("A" & Endpoint + 1).Value = .Range("A" & Endpoint + 1).Value & " " & .Range("A" & Endpoint + 2).Value
 .Rows(Endpoint + 2).EntireRow.Delete

 Startpoint = 0
 Endpoint = 0

 End If

 End If

 Next i

 End With

End Sub