ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Consolidate text (https://www.excelbanter.com/excel-programming/384568-consolidate-text.html)

Ianb

Consolidate text
 
Hi

I have a large spreadsheet that I need to trawl though consolidating column
cells. the process I haver been using is to select the cells and copy them
into word, convert them from table to text, copy the result, select the top
cell of the selection in excell and paste the result. This is a huge job
which could be speeded up hugely by a wee macro. I have used macros in MS
word and Access but the excel syntax is not familiar at all and I could
really do with some help.

In essence I need a macro that will take the contents of a selection (this
will be a number of cells containing text in a column) and join all of the
contents with a paragraph between. the resulting string is deposited in the
top cell and the remaining cells cleared of contents

I will have a go from examples I find but if someone has some code thay
could throw at me (or even some hints it would be well appreciated

Cheers
IanB

Jim Thomlinson

Consolidate text
 
Here is some code (modified from code designed to make CSV strings)...

Private Const m_cMaxConcatenateRows As Integer = 1000

Private Sub MakeCSV()
Dim wksCurrent As Worksheet
Dim rngCurrent As Range
Dim rngToSearch As Range
Dim rngToPaste As Range
Dim intCounter As Integer
Dim wksPasteTo As Worksheet

Application.ScreenUpdating = False
intCounter = 0
Set wksCurrent = ActiveSheet
Set rngToSearch = Intersect(Selection, wksCurrent.UsedRange)
Set rngToPaste = Selection.Cells(1)

rngToPaste.NumberFormat = "@"

For Each rngCurrent In rngToSearch
If Trim(rngCurrent.Value) < "" Then
intCounter = intCounter + 1
If intCounter m_cMaxConcatenateRows Then
intCounter = 0
Set rngToPaste = rngToPaste.Offset(1, 0)
rngToPaste.NumberFormat = "@"
rngToPaste.Value = rngCurrent.Value
Else
If intCounter = 1 Then
rngToPaste.Value = rngCurrent.Value
Else
rngToPaste.Value = rngToPaste.Value & vbLf &
rngCurrent.Value
rngCurrent.ClearContents
End If
End If
End If
Next rngCurrent
Application.ScreenUpdating = True
End Sub

--
HTH...

Jim Thomlinson


"Ianb" wrote:

Hi

I have a large spreadsheet that I need to trawl though consolidating column
cells. the process I haver been using is to select the cells and copy them
into word, convert them from table to text, copy the result, select the top
cell of the selection in excell and paste the result. This is a huge job
which could be speeded up hugely by a wee macro. I have used macros in MS
word and Access but the excel syntax is not familiar at all and I could
really do with some help.

In essence I need a macro that will take the contents of a selection (this
will be a number of cells containing text in a column) and join all of the
contents with a paragraph between. the resulting string is deposited in the
top cell and the remaining cells cleared of contents

I will have a go from examples I find but if someone has some code thay
could throw at me (or even some hints it would be well appreciated

Cheers
IanB


Ianb

Consolidate text
 
Thanks Jim

I have to say that is amazing service - just the solution and in just 10
minutes. It will save me a day al least - although it will probably take a
half a day to figure how it works :)
Good Kama on you


Ian


"Jim Thomlinson" wrote:

Here is some code (modified from code designed to make CSV strings)...

Private Const m_cMaxConcatenateRows As Integer = 1000

Private Sub MakeCSV()
Dim wksCurrent As Worksheet
Dim rngCurrent As Range
Dim rngToSearch As Range
Dim rngToPaste As Range
Dim intCounter As Integer
Dim wksPasteTo As Worksheet

Application.ScreenUpdating = False
intCounter = 0
Set wksCurrent = ActiveSheet
Set rngToSearch = Intersect(Selection, wksCurrent.UsedRange)
Set rngToPaste = Selection.Cells(1)

rngToPaste.NumberFormat = "@"

For Each rngCurrent In rngToSearch
If Trim(rngCurrent.Value) < "" Then
intCounter = intCounter + 1
If intCounter m_cMaxConcatenateRows Then
intCounter = 0
Set rngToPaste = rngToPaste.Offset(1, 0)
rngToPaste.NumberFormat = "@"
rngToPaste.Value = rngCurrent.Value
Else
If intCounter = 1 Then
rngToPaste.Value = rngCurrent.Value
Else
rngToPaste.Value = rngToPaste.Value & vbLf &
rngCurrent.Value
rngCurrent.ClearContents
End If
End If
End If
Next rngCurrent
Application.ScreenUpdating = True
End Sub

--
HTH...

Jim Thomlinson


"Ianb" wrote:

Hi

I have a large spreadsheet that I need to trawl though consolidating column
cells. the process I haver been using is to select the cells and copy them
into word, convert them from table to text, copy the result, select the top
cell of the selection in excell and paste the result. This is a huge job
which could be speeded up hugely by a wee macro. I have used macros in MS
word and Access but the excel syntax is not familiar at all and I could
really do with some help.

In essence I need a macro that will take the contents of a selection (this
will be a number of cells containing text in a column) and join all of the
contents with a paragraph between. the resulting string is deposited in the
top cell and the remaining cells cleared of contents

I will have a go from examples I find but if someone has some code thay
could throw at me (or even some hints it would be well appreciated

Cheers
IanB



All times are GMT +1. The time now is 06:33 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com