• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 242
  • Last Modified:

Excel Macro 2007 sorting, merging

Gentlemen
I appreciate the assitance in
I have column A : names of companies any particular company might be repaeated
any where in the column.  
I need to
1-copy the same data in the range A3-G60 into Sheet B
2-Sorted by company entry.
3-After each company string of entries there should be an empty row, this to include a en empty row in the begining    
3- in each of the empty rows cells from column b-g will be merged
4- content of the merged cells will be the company name that follow below
5- please see my screen shot of the final look

Screen-Shot-2011-10-30-at-16.48..jpg
0
Maverick1001
Asked:
Maverick1001
  • 9
  • 6
1 Solution
 
gowflowCommented:
Hi
Several questions:
1) Can you post a sample workbook it would make the details better to handle (like sheet names, header, format etc...)
2) You mentione "Sheet B" is it exactly like this or the default "Sheet2" ?
3) You want to copy A3-G60 to "Sheet B" but whatabout the header in Sheet B should we copy to A3 or A1 ?? all this is not defined and posting sample workbook would avoid all these questions.

As far as your request it is pretty simple once you reply to my questions even if not posted I will hv the macro ready for you.

gowflow
0
 
Robberbaron (robr)Commented:
try this macro code from current worksheet.  will copy to new worksheet and work on that one
Option Explicit
Sub CopyFormatSheet()
    Dim currs As Worksheet, rngSort As Range, rngSortKey As Range
    Dim oldcompany As String, i As Integer, rngsize As Integer
    ActiveSheet.Copy before:=Sheets(2)
    
    Set currs = ActiveSheet
    Set rngSort = currs.UsedRange
    
    '>1>> do the sort
    Set rngSortKey = rngSort.Columns(1)
    currs.Sort.SortFields.Clear
    currs.Sort.SortFields.Add Key:=rngSortKey _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With currs.Sort
        .SetRange rngSort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    '>2>>>add empty rows & apply header
    oldcompany = ""
    rngsize = rngSort.Columns.Count
    i = 1
    Do While i < rngSort.Rows.Count
        i = i + 1
        If rngSort.Cells(i, 1).Value <> oldcompany Then
            oldcompany = rngSort.Cells(i, 1).Value
            'insert a blank row
            rngSort.Rows(i).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
           
            'merge cells
            rngSort.Rows(i).Cells.Offset(0, 1).Resize(1, rngsize - 1).Merge
            
            'set merged value
            rngSort.Rows(i).Cells(2).Value = rngSort.Rows(i + 1).Cells(1).Value
            rngSort.Rows(i).Cells(2).HorizontalAlignment = xlCenter
            rngSort.Rows(i).Cells(2).VerticalAlignment = xlBottom
            rngSort.Rows(i).Cells(2).Font.Bold = True
        End If
    Loop
    
End Sub

Open in new window

0
 
Maverick1001Author Commented:
Hello
@ robberbaron:
The new merged cell shoubd be from column B-G, here its from B-T
After merging can the text inside be centered ?
regards
0
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
Maverick1001Author Commented:
One more thing how can I name the MACRO "Create Report"
0
 
Maverick1001Author Commented:
Hi
I found out some issues, please see the yellow highlighted  cells when you apply the macro

thanx
test1.xlsx
0
 
gowflowCommented:
Sorry for delay in answer, If yoour still intrested here is my version based on the workbook you have posted. As you have requested in Sheet B. Still did not see your comments on my initial request though !

gowflow
test1.xlsm
0
 
Maverick1001Author Commented:
Sorry for no answering
@gowflow:
looks fine , 2 comments :
1-can you highlight the merged cells with a color say light gray
2-can the text boxes at the end of the sheet be copied

regards
0
 
Maverick1001Author Commented:
@gowflow: and the merge should be from B to G
0
 
gowflowCommented:
sure sorry my mistake, remember you mentioned B to G.
You want the highlighting from A to G or B to G ? B to G look like a bit cut anyway your choice.
gowflow
0
 
Maverick1001Author Commented:
B to G please
0
 
gowflowCommented:
Here it is
gowflow
test1.xlsm
0
 
Maverick1001Author Commented:
Hi
a small issue, see attached
and a question what is the cell range covered by this macro

regards
Screen-Shot-2011-11-01-at-00.23..jpg
0
 
gowflowCommented:
you mean the extra button can be removed and the cell range is as requested A3:G60

Anyway to correct the pasting of drawing please replace at the end of the code the For I loop by the below code

 
For I = 1 To WS.Shapes.Count
    If WS.Shapes(I).Type = msoGroup Then
        WS.Shapes(I).Copy
        WSSort.Range("B" & MaxRow + 3).PasteSpecial
    End If
Next I

Open in new window


If you are not too familiar I have posted the workbook for your convenience.
gowflow
test1.xlsm
0
 
Maverick1001Author Commented:
much appreciated
thanx
0
 
Maverick1001Author Commented:
quick and as requested
0
 
gowflowCommented:
thank you for the grade and gald I could help.
gowflow
0

Featured Post

Hire Technology Freelancers with Gigs

Work with freelancers specializing in everything from database administration to programming, who have proven themselves as experts in their field. Hire the best, collaborate easily, pay securely, and get projects done right.

  • 9
  • 6
Tackle projects and never again get stuck behind a technical roadblock.
Join Now