Excel macro merge cells 1

[andycapp28]

I have an excel spreadsheet that I need advice on how to merge rows/cols and drop the surplus rows. The following sample from the excel file is as follows.
Row Col A Col B Col C Col D Col E Col F
1 24/03/92-139 5668 Kilkeel 81161 Wool £1,157.38
2 24/03/92-139 5668 Kilkeel 3901 Cotton £1,157.38
3 24/03/92-139 5668 Kilkeel 1079 Paper £1,157.38

I need on change of Col B to concatanate Col D and Col E from rows 1, 2 and 3 into row 1 Col D and Col E. Then drop rows 2 and 3. The results I require would hopefully look something like this.

Row Col A Col B Col C Col D
1 24/03/92-139 5668 Kilkeel 81161 and 3901 and 1079
Col E Col F
Wool and Cotton and Paper £1,157.38

Is this possible to achieve, if so I need help and must include contingency for Col B value appearing just the once.

I would really appreciate any advice even if its to confirm its feasible.

AC

 

[xlbo]

Certainly feasible although I would hesitiate to get rid of your original data as it is in a far better shape for aggregation and usage of excel functions

Best bet is something like this - insert a blank line at the top of your data if you do not have headers as we are going to compare each line to the previous line and if we start on row 1, it will throw an error

dim rwBase as long, rwToUse as long, rwLast as long

dim shtBase as worksheet, shtReForm as worksheet

Set shtBase = sheets("Base Data Sheet")

Set shtReForm = sheets("New Sheet")

'Find the last row of data to loop to
rwLast = shtBase.cells(65536,1).end(xlup).row
'Set the row to use on the new sheet
rwToUse = 0

With shtBase

For rwBase = 2 to rwLast

If .cells(rwBase,2) <> .cells(rwBase-1,2) then
    'Change of code - copy data to new sheet
    rwToUse = rwToUSe + 1
    .Range(.cells(rwBase,1),.cells(rwBase,6)).copy destination:= shtReForm.cells(rwToUse,1)

Else
    'Continuation of value in col B - amend columns D & E
    shtReForm.cells(rwToUse,4).value = shtReForm.cells(rwToUse,4).value & " AND " & .cells(rwBase,4).value
    shtReForm.cells(rwToUse,5).value = shtReForm.cells(rwToUse,5).value & " AND " & .cells(rwBase,5).value

End if

Next rwBase

end With

Rgds, Geoff

We could learn a lot from crayons. Some are sharp, some are pretty and some are dull. Some have weird names and all are different colours but they all live in the same box.

Please read FAQ222-2244 before you ask a question

 

[SkipVought]

Hi,

What is this supposed to be?
[tt]
24/03/92-139
[/tt]
It appears that it might be an attempt at a date followed by something else. As a date, it is nearly useless as it cannot be used in any way as a date in a collation or calculation.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[andycapp28]

Skip,

It's an exported field from a database, its used as a text identifier not a date at all.

Just need code to read col B and on change concatanate col D and Col E from the matching col B rows.

 

[SkipVought]

BTW, Merge in Excel, means something entirely different than you problem.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[xlbo]

...so did the code work???

Rgds, Geoff

We could learn a lot from crayons. Some are sharp, some are pretty and some are dull. Some have weird names and all are different colours but they all live in the same box.

Please read FAQ222-2244 before you ask a question

 

[andycapp28]

xlbo, Hi

I'm needing to understand how to add columns in as the example was just a snapshot of the xl file to determine feasibility.

It compiled which I always find initially satisfying.

AC

 

[xlbo]

this bit:

shtReForm.cells(rwToUse,4).value = shtReForm.cells(rwToUse,4).value & " AND " & .cells(rwBase,4).value
shtReForm.cells(rwToUse,5).value = shtReForm.cells(rwToUse,5).value & " AND " & .cells(rwBase,5).value


does the addition of values in the cells - specifically,the 4 & 5 are the column numbers

This controls the initial paste iof data:

.Range(.cells(rwBase,1),.cells(rwBase,6)).copy destination:= shtReForm.cells(rwToUse,1)


the 6 determines which column number to paste up to

Rgds, Geoff

We could learn a lot from crayons. Some are sharp, some are pretty and some are dull. Some have weird names and all are different colours but they all live in the same box.

Please read FAQ222-2244 before you ask a question

 

[andycapp28]

Geoff, that's fine thanks I realised that after I responded, what I did want to resolve though was how to initially copy row 1 (headings) as these are being lost?

AC

 

[xlbo]

Just add it before the loop:

With shtBase

.Range(.cells(1,1),.cells(1,6)).copy destination:= shtReForm.cells(1,1)

For rwBase = 2 to rwLast


Rgds, Geoff

We could learn a lot from crayons. Some are sharp, some are pretty and some are dull. Some have weird names and all are different colours but they all live in the same box.

Please read FAQ222-2244 before you ask a question

 

[andycapp28]

hi it's been awhile now since I logged and got help with this.

Upon putting it into a live test, it will not pass the shtReForm add of worksheet line, it gives subscript out of range error.

Can anyone explain why please?

Sub Multi_Funds_Desc()

Dim rwBase As Long, rwToUse As Long, rwLast As Long

Dim shtBase As Worksheet, shtReForm As Worksheet

Set shtWbook = Workbooks.Open("G:\Marketing\Supporters and appeals\Parish Fundraising\Thank you Certificates\TY_Certificates_Month.xls")

Set shtBase = shtWbook.Sheets("TY_Certificates_Month")

Set shtReForm = shtWbook.Sheets("TY_Certificates_Month_Funds")

'Find the last row of data to loop to

rwLast = shtBase.Cells(65536, 1).End(xlUp).Row

'Set the row to use on the new sheet

rwToUse = 0

With shtBase

.Range(.Cells(1, 1), .Cells(1, 6)).Copy Destination:=shtReForm.Cells(1, 1)

For rwBase = 2 To rwLast
 
 If .Cells(rwBase, 4) <> .Cells(rwBase - 1, 4) Then
   'Change of Constituent Id (column D)- copy data to new sheet
   rwToUse = rwToUse + 1
  .Range(.Cells(rwBase, 1), .Cells(rwBase, 21)).Copy Destination:=shtReForm.Cells(rwToUse, 1)

Else
   'Continuation of Constituent ID value in col D - amend columns O & P
    shtReForm.Cells(rwToUse, 15).Value = shtReForm.Cells(rwToUse, 15).Value & " AND " & .Cells(rwBase, 15).Value
    shtReForm.Cells(rwToUse, 16).Value = shtReForm.Cells(rwToUse, 16).Value & " AND " & .Cells(rwBase, 16).Value

End If

Next rwBase

End With

Workbooks.Close

End Sub

 

[SkipVought]

...it will not pass the shtReForm add of worksheet line, it gives subscript out of range error.

You do not have any worksheets.add, but you do have

    Set shtReForm = shtWbook.Sheets("TY_Certificates_Month_Funds")

That error means that the referenced sheet is non-existent. Check you spelling!

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[andycapp28]

Skip

Spelling is correct , what I need is help as to how to add that worksheet name to an existing workbook? All my atempts with worksheets.add fail!

AC

 

[SkipVought]

how to add that worksheet name to an existing workbook

You do not add worksheet names to workbooks.

To ADD a worksheet...

    Set shtReForm = shtWbook.Sheets.add
    
    shtReForm.Name = "TY_Certificates_Month_Funds"

To name an existing sheet, you have to reference that sheet in some way like...

'LAST sheet in the workbook
Sheets(sheets.count).name = "TY_Certificates_Month_Funds"

'using the activesheet
activesheet.name = "TY_Certificates_Month_Funds"

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[andycapp28]

Many Thanks Skip, I will put the code into test at work tomorrow.

AC

 

[andycapp28]

I have endured a problem with my initial requirements.

as my xls file is derived from a sqlserver database I have been given the data in three separate workbooks. I need to combine all this into a single excel file to then enable me to use it in a mail merge.

Before describing my code thus far and complete requirements for help I have uploaded 3 sample excel files to media fire.
Having never done this before, can anyone find some time to help initially by letting me know if they can view all 3 sample files please?

 

[SkipVought]

Andy,

Is this a different issue than the one referenced in the TITLE of this thread? If so, please start a new thread.

BTW, many of us are restricted by company security from accessing files from the web.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[andycapp28]

Skip, thanks for looking at this again, sorry to have not realised about the files. I think its still under the Title of thread as its still trying to get to a single workbook.
If you disagree then I bow to your experience and will raise a new one.

I have three csv files
1. Addressee
2. Fund Total Amnts
3. Fund Desc.

I need to get 1 and 2 into a single workbook and as part need the Fund description from file 2 replaced with that held in file 3. Both File 2 and 3 have a Fund Id to match on. All Fund Id's exist in file 3 but some without an alternative description so the Fund description from File 2 must be used in these cases.

1. and 2. hold a column (Cons ID) that can be used to enable matching rows so I see it possible to use match or vlookup.

Hopefully then I'll get a Single workbook
Cons ID, Addressee, Address, Total Amnts from File 2, Fund Description from File 3 else default File 2.

Please say it can be done

Regards
AC

 

[SkipVought]

as my xls file is derived from a sqlserver database

You do realize that you can query a database directly from Excel, so, in reality, you would not need the three workbooks, just 3 queries on 3 sheets.

Alternatively, you can query each of the three workbooks to get the data into 3 sheets.

Finally you can again, use MS Query to query all 3 sheets to combine & summiaize as needed in a 4th sheet.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[andycapp28]

Its a relational database that I do not have the schema to know the structure and or direct access to sqlserver, hence I only able to use the tools from within the package.

AC