VBA - Concatenate currently selected cell with cell below

[guybrown]

Hi

I'm copying text from a PDF document and pasting into Excel. If the text in the PDF is a paragraph, Excel pastes seperate lines rather than 1 continuous string.

This is what I have:

<TABLE style="WIDTH: 461pt; BORDER-COLLAPSE: collapse" border=0 cellSpacing=0 cellPadding=0 width=615><COLGROUP><COL style="WIDTH: 461pt; mso-width-source: userset; mso-width-alt: 22491" width=615><TBODY><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; WIDTH: 461pt; HEIGHT: 15pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl65 height=20 width=615>while transport specific strategies may address such</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; WIDTH: 461pt; HEIGHT: 15pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl65 height=20 width=615>questions as the roles of the public and private sectors in road or rail infrastructure</TD></TR></TBODY></TABLE>

I want to select the first cell and run a macro that adds the text in the cell below to it and replaces the cell below with nothing.

Ideally - it would concatenate any other rows below also, say the 5 rows below it...

Is this possible?

 

[Rick Rothstein]

I'm a little concerned that since this is from a document file, the concatenated lines of text might end up too long to display in a single cell. But you also seemed to indicate you don't have lots of lines of text, so give this code a try and see...

Sub ConcatPDFlines()
  Dim PDFlines As Range
  Set PDFlines = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
  Range("A1").Value = Join(WorksheetFunction.Transpose(PDFlines))
  PDFlines.Offset(1).Resize(PDFlines.Rows.Count - 1).Clear
End Sub

Oh, by the way, the above code assumes your text is in Column A starting in Row 1.

 

[hiker95]

guybrown,


Sampe data before the macro, with cell B4 as the active cell:

Excel Workbook
	B
4	while transport specific strategies may address such
5	questions as the roles of the public and private sectors in road or rail infrastructure
6
Sheet1

After the macro, with cell B4 as the active cell:

Excel Workbook
	B
4	while transport specific strategies may address such questions as the roles of the public and private sectors in road or rail infrastructure
5
6
Sheet1

Sampe data before the macro, with cell D18 as the active cell:

Excel Workbook
	D
18	while transport specific
19	strategies may address such
20	questions as the roles
21	of the public and
22	private sectors in road
23	or rail infrastructure
24
Sheet1

After the macro, with cell D18 as the active cell:

Excel Workbook
	D
18	while transport specific strategies may address such questions as the roles of the public and private sectors in road or rail infrastructure
19
20
21
22
23
24
Sheet1

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).


1. Copy the below code, by highlighting the code and pressing the keys CTRL + C
2. Open your workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code by pressing the keys CTRL + V
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel, open the workbook, and press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Option Explicit
Sub MyConcat()
' hiker95, 06/30/2011
' http://www.mrexcel.com/forum/showthread.php?t=561332
Dim SR As Long, ER As Long, SC As Long
Dim H As String
Application.ScreenUpdating = False
SR = ActiveCell.Row
SC = ActiveCell.Column
Do Until ActiveCell = ""
  ActiveCell.Offset(1).Select
Loop
ER = ActiveCell.Row - 1
H = Join(Application.Transpose(Range(Cells(SR, SC), Cells(ER, SC))), " ")
Range(Cells(SR, SC), Cells(ER, SC)).ClearContents
With Cells(SR, SC)
  .Value = H
  .WrapText = True
  .Select
End With
Application.ScreenUpdating = True
End Sub

Then run the MyConcat macro.

 

[hiker95]

guybrown,

This version of the macro assumes that there is at least one more data cell below the active cell.


Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Option Explicit
Sub MyConcatV2()
' hiker95, 06/30/2011
' http://www.mrexcel.com/forum/showthread.php?t=561332
Dim SR As Long, ER As Long, SC As Long
Dim H As String
Application.ScreenUpdating = False
SR = ActiveCell.Row
SC = ActiveCell.Column
ActiveCell.End(xlDown).Select
ER = ActiveCell.Row
H = Join(Application.Transpose(Range(Cells(SR, SC), Cells(ER, SC))), " ")
Range(Cells(SR, SC), Cells(ER, SC)).ClearContents
With Cells(SR, SC)
  .Value = H
  .WrapText = True
  .Select
End With
Application.ScreenUpdating = True
End Sub

Then run the MyConcatV2 macro.

 

[hiker95]

guybrown,

This modification to the first macro will work with one data row, or with multiple data rows.


Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Sub MyConcatV1()
' hiker95, 06/30/2011
' http://www.mrexcel.com/forum/showthread.php?t=561332
Dim SR As Long, ER As Long, SC As Long
Dim H As String
Application.ScreenUpdating = False
SR = ActiveCell.Row
SC = ActiveCell.Column
Do Until ActiveCell = ""
  ActiveCell.Offset(1).Select
Loop
ER = ActiveCell.Row - 1
If SR = ER Then
  Cells(SR, SC).Select
  Exit Sub
Else
  H = Join(Application.Transpose(Range(Cells(SR, SC), Cells(ER, SC))), " ")
End If
Range(Cells(SR, SC), Cells(ER, SC)).ClearContents
With Cells(SR, SC)
  .Value = H
  .WrapText = True
  .Select
End With
Application.ScreenUpdating = True
End Sub

Then run the MyConcatV1 macro.

 

[JSuarez]

I'm a little concerned that since this is from a document file, the concatenated lines of text might end up too long to display in a single cell. But you also seemed to indicate you don't have lots of lines of text, so give this code a try and see...

Sub ConcatPDFlines()
  Dim PDFlines As Range
  Set PDFlines = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
  Range("A1").Value = Join(WorksheetFunction.Transpose(PDFlines))
  PDFlines.Offset(1).Resize(PDFlines.Rows.Count - 1).Clear
End Sub

Oh, by the way, the above code assumes your text is in Column A starting in Row 1.

Hello, is it possible to include a comma as a delimiter for each of the rows?

 

[Fluff]

How about

Sub ConcatPDFlines()
  Dim PDFlines As Range
  Set PDFlines = Range("A1:A" & Cells(Rows.count, "A").End(xlUp).Row)
  Range("A1").Value = Join(WorksheetFunction.Transpose(PDFlines), ",")
  PDFlines.Offset(1).Resize(PDFlines.Rows.count - 1).Clear
End Sub

 

[JSuarez]

Thank you much Fluff for the assistance, always appreciate the simple and powerful codes. I feel kind of ashamed, on account I thought I tried this earlier with no success.

 

[Fluff]

Glad to help & thanks for the feedback