VBA if cell contains copy to another cell with a catch

[mtnbkr0918]

I have a spreadsheet that contains data in column A that I need to combine the cells below it. I have attached screenshot and attach the sample spreadsheet.

so cell a1, a2, skip a3 (has the word hardware), a4, and a5 combined into one row with a comma seaparting each cell

A1	fc1	fc1,Port Desc fc1,Port WWN 1,Peer port WWN 1-1
A2	Port Desc fc1
A3	Hardware
A4	Port WWN 1
A5	Peer port WWN 1-1

There is one catch. Some of the cells do not have a Port Desc FCx and this is random. To do this manually takes too long.

Any help will be greatly apprecaited.

so the combine would look like this.

A7	fc2	fc2,No Desc,Port WWN 2,Peer port WWN 2-2	Missing Port Desc
A8	Hardware
A9	Port WWN 2
A10	Peer port WWN 2-2

Between each FCx is a cell with -- so they would need to be skipped

A1	fc1	fc1,Port Desc fc1,Port WWN 1,Peer port WWN 1-1	has port desc so it needs to be included
A2	Port Desc fc1
A3	Hardware
A4	Port WWN 1
A5	Peer port WWN 1-1
A6	--
A7	fc2	fc2,No Desc,Port WWN 2,Peer port WWN 2-2	Missing Port Desc
A8	Hardware
A9	Port WWN 2
A10	Peer port WWN 2-2
A11	--
A12	fc3	fc3,Port Desc fc3,Port WWN 3,Peer port WWN 3-3	has port desc so it needs to be included
A13	Port Desc fc3
A14	Hardware
A15	Port WWN 3
A16	Peer port WWN 3-3
A17	--

Any help would be greatly apprecaited

 

[kvsrinivasamurthy]

Data in A:B. Result will be in Column C.
VBA code:

Sub JoinText()
Dim M, A
Dim Lr&, T&, Ta&, R1&, R2&
Lr = Range("A" & Rows.Count).End(xlUp).Row
A = Sheets("Sheet1").Range("A1:B" & Lr)
ReDim B(1 To Lr, 1 To 1)
'k = "IF(lefT(B1:B" & Lr & ",2)=""fc"",Row(B1:B" & Lr & "),false)"
M = Filter(Evaluate("Transpose(IF(lefT(B1:B" & Lr & ",2)=""fc"",Row(B1:B" & Lr & "),false))"), False, False)
For T = LBound(M) To UBound(M)
R1 = M(T): If T = UBound(M) Then R2 = Lr - 1 Else R2 = M(T + 1) - 1

If Left(A(R1 + 1, 2), 12) <> "Port Desc fc" Then A(R1 + 1, 2) = "No Desc"
    For Ta = R1 To R2
    B(R1, 1) = B(R1, 1) & "," & A(Ta, 2)
    Next Ta
If B(R1, 1) <> "" Then B(R1, 1) = Mid(B(R1, 1), 2)

Next T
Range("C:C").Clear
Range("c1").Resize(M(UBound(M)), 1) = B
End Sub

A1	fc1	fc1,Port Desc fc1,Hardware,Port WWN 1,Peer port WWN 1-1,
A2	Port Desc fc1
A3	Hardware
A4	Port WWN 1
A5	Peer port WWN 1-1
A7	fc2	fc2,No Desc,Port WWN 2,Peer port WWN 2-2,
A8	Hardware
A9	Port WWN 2
A10	Peer port WWN 2-2
A12	fc3	fc3,Port Desc fc3,Hardware,Port WWN 3,Peer port WWN 3-3
A13	Port Desc fc3
A14	Hardware
A15	Port WWN 3
A16	Peer port WWN 3-3
A17	--

 

[kvsrinivasamurthy]

If Data in column A. Result in Column B.
VBA code:

Sub JoinText()
Dim M, A
Dim Lr&, T&, Ta&, R1&, R2&
Lr = Range("A" & Rows.Count).End(xlUp).Row
A = Sheets("Sheet1").Range("A1:A" & Lr)
ReDim B(1 To Lr, 1 To 1)
M = Filter(Evaluate("Transpose(IF(lefT(A1:A" & Lr & ",2)=""fc"",Row(A1:A" & Lr & "),false))"), False, False)

For T = LBound(M) To UBound(M)
R1 = M(T): If T = UBound(M) Then R2 = Lr - 1 Else R2 = M(T + 1) - 1

If Left(A(R1 + 1, 1), 1) <> "Port Desc fc" Then A(R1 + 1, 1) = "No Desc"
    For Ta = R1 To R2
    B(R1, 1) = B(R1, 1) & "," & A(Ta, 1)
    Next Ta
If B(R1, 1) <> "" Then B(R1, 1) = Mid(B(R1, 1), 2)

Next T
Range("B:B").Clear
Range("B1").Resize(M(UBound(M)), 1) = B
End Sub

fc1	fc1,No Desc,Hardware,Port WWN 1,Peer port WWN 1-1,
Port Desc fc1
Hardware
Port WWN 1
Peer port WWN 1-1
fc2	fc2,No Desc,Port WWN 2,Peer port WWN 2-2,
Hardware
Port WWN 2
Peer port WWN 2-2
fc3	fc3,No Desc,Hardware,Port WWN 3,Peer port WWN 3-3
Port Desc fc3
Hardware
Port WWN 3
Peer port WWN 3-3
--

 

[mtnbkr0918]

If Data in column A. Result in Column B.
VBA code:

Sub JoinText()
Dim M, A
Dim Lr&, T&, Ta&, R1&, R2&
Lr = Range("A" & Rows.Count).End(xlUp).Row
A = Sheets("Sheet1").Range("A1:A" & Lr)
ReDim B(1 To Lr, 1 To 1)
M = Filter(Evaluate("Transpose(IF(lefT(A1:A" & Lr & ",2)=""fc"",Row(A1:A" & Lr & "),false))"), False, False)

For T = LBound(M) To UBound(M)
R1 = M(T): If T = UBound(M) Then R2 = Lr - 1 Else R2 = M(T + 1) - 1

If Left(A(R1 + 1, 1), 1) <> "Port Desc fc" Then A(R1 + 1, 1) = "No Desc"
    For Ta = R1 To R2
    B(R1, 1) = B(R1, 1) & "," & A(Ta, 1)
    Next Ta
If B(R1, 1) <> "" Then B(R1, 1) = Mid(B(R1, 1), 2)

Next T
Range("B:B").Clear
Range("B1").Resize(M(UBound(M)), 1) = B
End Sub

fc1	fc1,No Desc,Hardware,Port WWN 1,Peer port WWN 1-1,
Port Desc fc1
Hardware
Port WWN 1
Peer port WWN 1-1
fc2	fc2,No Desc,Port WWN 2,Peer port WWN 2-2,
Hardware
Port WWN 2
Peer port WWN 2-2
fc3	fc3,No Desc,Hardware,Port WWN 3,Peer port WWN 3-3
Port Desc fc3
Hardware
Port WWN 3
Peer port WWN 3-3
--

Thank you so much. This worked perfectly.

 

[kvsrinivasamurthy]

Welcome

 

[Peter_SSs]

For MS365, what about just this?

Sub Join_Text()
  With Range("B1:B" & Range("A" & Rows.Count).End(xlUp).Row)
    .Formula2 = "=IF(LEFT(A1,2)=""fc"",TEXTJOIN("","",,A1,IF(LEFT(A2,9)=""Port Desc"","""",""No Desc""),SUBSTITUTE(A2:INDEX(A3:A$1000,MATCH(""--"",A3:A$1000,0)-1),""Hardware"","""")),"""")"
    .Value = .Value
  End With
End Sub