-2

I am trying to automate a report generation process in excel. So, let me give you guys a background:- I have 3 columns in my datasheet:
enter image description here

Column A is manufacturing location

Column B is Vehicle line

Column C is Progress Update

I trying to generate a report which merges and centers MFG Locations in Column A and the same time Merge and Centers Vehicle lines in that plant with Column B

I am attaching a sample of the output I need. As of now , I am manually doing this process, I hope someone can guide me with automating this process

Data Sheet and Output report required

K.Dᴀᴠɪs
  • 9,945
  • 11
  • 33
  • 43
agastyateja
  • 1
  • 1
    Dude! I'm not your research assistant. Get started on a solution and if you run into trouble, come back with a specific question. Failing that, hire a programmer. I suggest you read the link I provided and heed the advice given. –  Feb 21 '18 at 06:33
  • Did you try recording macro? This is how I studied VBA at first (sort of). – AntiDrondert Feb 21 '18 at 06:53
  • It's always good to start with a tutorial. – Egan Wolf Feb 21 '18 at 06:54
  • 1
    You might be confused where to start, so I'll decompose this task for you. First you need to define your data range (calculate [last non empty cell](https://stackoverflow.com/questions/11169445/error-in-finding-last-used-cell-in-vba/11169920#11169920) in column A and define your range). Then you need to sort it by columns A and B ascending, C descending. After that, figure out how to check for similiar values and merge these cells accordingly. – AntiDrondert Feb 21 '18 at 07:01

1 Answers1

0

This code will help you what you have asked.

Sub MergeSameCells()
Dim Rng As Range
Dim xRows, lastRow As Integer

lastRow = Cells(Rows.Count, 1).End(xlUp).Row

Range("A2:C" & lastRow).Select

With ActiveWorkbook.ActiveSheet.Sort
    With .SortFields
    .Clear
    .Add Key:=Range("A2:A" & lastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    .Add Key:=Range("B2:B" & lastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    .Add Key:=Range("C2:C" & lastRow), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    End With
    .SetRange Range("A2:C" & lastRow)
    .Header = xlGuess
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

Set WorkRng = Range("A2:B" & lastRow)
xRows = WorkRng.Rows.Count

If WorkRng Is Nothing Then Exit Sub

Application.ScreenUpdating = False
Application.DisplayAlerts = False

For Each Rng In WorkRng.Columns
    For i = 1 To xRows - 1
        For j = i + 1 To xRows
            If Rng.Cells(i, 1).Value <> Rng.Cells(j, 1).Value Then
                Exit For
            End If
        Next
        WorkRng.Parent.Range(Rng.Cells(i, 1), Rng.Cells(j - 1, 1)).Merge
        i = j - 1
    Next
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Try and let me know if it works.

Vipul Karkar
  • 327
  • 1
  • 3
  • 11
  • Glad to help. If it helped you, please mark this question as Answered so it doesn't reflect in the list of "Unanswered" category. – Vipul Karkar Feb 21 '18 at 12:36