Concatenate Rows if Cell content is Bold

[Blessy Clara]

Hi,

I have data in Range (A2:A50000) Cells with no blank-rows. The data is a collection of Various Libraries and their contact details. The Only differentiating factor between one Library to another is they are in Bold. But the trickiest part is some of the organization names occur in two rows. I need to make that into a single row. Could this be done using VBA (to work Manually for these 4000 organizations seems hectic)

Conditions
1) Cell value is bold
2) The next/following cell (downward) is also bold - Then Concatenate both the rows and paste value in the first cell (Not A1) and make the cell content bold.

Example
A22 AARP
A23 Research Information centre

After Code
A22 AARP Research Information Center
A23 blank row

To Note
1) The number of rows in between the bold (cell value) differs
2) Sometime the org name can appear in just a single Row (in that case it can be ignored) No need to concatenate (see below Highlighted Red)

For view


AARP
Research Information Center
601 E St NW, B3-400
Washington, DC 20049
UNITED STATES
Internet Resources on Aging
[Abbott
Library Information Resources
100 Abbott Park Rd, AP 6B
Abbott Park, IL 60064-6107
UNITED STATES
Abbott Laboratories Ltd Library
8401 Trans Canada Hwy
Ville St'Laurent
Saint Laurent, QC H4S 1Z1
CANADA
ABC-CLIO Inc
Inge Pauli Boehm Library
130 Cremona Dr
Santa Barbara, CA 93117-5505
UNITED STATES
Academy for Educational Development
AED Information Services Center
1825 Connecticut Ave NW
Washington, DC 20009-5721
UNITED STATES
Library Type:*Special
Academy for Educational Development
Margaret Herrick Library
333 S La Cienega Blvd
Beverly Hills, CA 90211
UNITED STATES
Library Type:*Special
Telephone:
310-247-3020 - Reference
310-247-3000 - General
Fax:
310-657-5193 - General
Thomas Ince Coll
Sidney Skolsky Coll
Academy of Natural Sciences of Philadelphia
Ewell Sale Stewart Library
1900 Benjamin Franklin Pkwy
Philadelphia, PA 19103-1195

Any help is greatly appreciated

 

[Michael M]

Maybe this....Try it on a test sheet first

Sub joinem()
Dim lr As Long, r As Long
lr = Cells(Rows.Count, "A").End(xlUp).Row
    For r = lr To 2 Step -1
        If Range("A" & r).Font.Bold = True And Range("A" & r - 1).Font.Bold = True Then
            Range("A" & r - 1).Value = Range("A" & r - 1).Value & " " & Range("A" & r).Value
                Range("A" & r).ClearContents
        End If
    Next r
End Sub

 

[Blessy Clara]

Dear Michael M

Thank you very much for your response. Appreciate your time and effort.
This code has done what I was looking out for - Thank you once again.

 

[Michael M]

My pleasure, thanks for the feedback....