How Can I - Move

[sallyholly]

Hello,

I wonder if there's an easy way for me to move certain text in column B, to go beneath headings in column A... Sometimes the text in column B appears on the same line as the Heading in Column A, sometimes a row down, sometimes there is one line in Column B, sometimes up to twenty and there are a lot of headings! Hope you can see what I mean by this....

[TABLE="width: 192"]
<tbody>[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
[TABLE="width: 226"]
<tbody>[TR]
[TD]Heading 1[/TD]
[TD]Text for 1[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Text for 1[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Text for 1[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Heading 2[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]text for 2[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]text for 2[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Heading 3[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]text for 3[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

I would like it to end up looking like this...


[TABLE="width: 162"]
<tbody>[TR]
[TD]Heading 1[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Text for 1[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Text for 1[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Text for 1[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Heading 2[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]text for 2[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]text for 2[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Heading 3[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]text for 3[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

I would also like to format the headings only to underline and bold but not the text (although this isn't as important as aligning).

Thank you in anticipation.

 

[MickG]

Try this for results on sheet2.

[COLOR="Navy"]Sub[/COLOR] MG28Aug31
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Fd [COLOR="Navy"]As[/COLOR] Boolean
[COLOR="Navy"]Set[/COLOR] Rng = Range("A1", Range("B" & Rows.Count).End(xlUp))
MsgBox Rng.Address
ReDim Ray(1 To Rng.Count * 2)
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]If[/COLOR] Not IsEmpty(Dn.Value) [COLOR="Navy"]Then[/COLOR]
        c = c + 1
        [COLOR="Navy"]If[/COLOR] c > 1 And Dn.Column = 1 [COLOR="Navy"]Then[/COLOR] c = c + 1
            Ray(c) = Dn.Value
        [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]Set[/COLOR] Rng = Sheets("Sheet2").Range("a1").Resize(c, 1)
Rng.Value = Application.Transpose(Ray)


[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng.SpecialCells(xlCellTypeConstants).Areas
   Dn(1).Font.Bold = True
   Dn(1).Font.Underline = True
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[sallyholly]

OMG!!! That's just great thanks so much Mick. I wonder if I could encroach further on your generosity of knowledge! I forgot I've also got some information in column C which should stay together with the text in column B. I'm not au fait with these macros (apart from pressing 'run') - is that a quick little alteration you could make for me please?
Really appreciate this, making this so quick for me!
Thank you.

 

[MickG]

Try this:-

[COLOR="Navy"]Sub[/COLOR] MG28Aug15
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Fd [COLOR="Navy"]As[/COLOR] Boolean
[COLOR="Navy"]Set[/COLOR] Rng = Range("A1", Range("B" & Rows.Count).End(xlUp))
ReDim Ray(1 To Rng.Count * 2, 1 To 2)
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]If[/COLOR] Not IsEmpty(Dn.Value) [COLOR="Navy"]Then[/COLOR]
        c = c + 1
        [COLOR="Navy"]If[/COLOR] c > 1 And Dn.Column = 1 [COLOR="Navy"]Then[/COLOR] c = c + 1
            Ray(c, 1) = Dn.Value
        [COLOR="Navy"]If[/COLOR] Dn.Column = 2 [COLOR="Navy"]Then[/COLOR] Ray(c, 2) = Dn.Offset(, 1).Value
        
        [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]Set[/COLOR] Rng = Sheets("Sheet2").Range("a1").Resize(c, 2)
Rng.Value = Ray
[COLOR="Navy"]Set[/COLOR] Rng = Rng.Resize(c, 1)

[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng.SpecialCells(xlCellTypeConstants).Areas
   Dn(1).Font.Bold = True
   Dn(1).Font.Underline = True
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[sallyholly]

Thank you so much Mick, you are amazing.

 

[MickG]

You're welcome