VBA - Concatenate currently selected cell with cell below

guybrown

Board Regular
Joined
Jul 2, 2008
Messages
100
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? :confused:
 
Last edited:

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
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...

Code:
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.
 
Upvote 0
guybrown,


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


Excel Workbook
B
4while transport specific strategies may address such
5questions 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
4while 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
18while transport specific
19strategies may address such
20questions as the roles
21of the public and
22private sectors in road
23or rail infrastructure
24
Sheet1





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


Excel Workbook
D
18while 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.


Code:
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.
 
Upvote 0
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).


Code:
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.
 
Upvote 0
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).


Code:
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.
 
Upvote 0
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...

Code:
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?
 
Upvote 0
How about
Rich (BB code):
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
 
Last edited:
Upvote 0
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. :)
 
Upvote 0
Glad to help & thanks for the feedback
 
Upvote 0

Forum statistics

Threads
1,224,521
Messages
6,179,277
Members
452,902
Latest member
Knuddeluff

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top