Macro to combine data under 3rd and 4th Column if condn satisfy for 1st , 2nd column

[shan]

Hello Everybody,

Good Morning!!

I am looking for a macro which will combine the data available in 3rd and 4th Column if conditions satisfied for 1st and 2nd Column.

Below Input and Output data for your reference..

INPUT
KM	Leg	Org	Dest
2,019,769,184	1	BOM	DEL
2,019,769,184	2	DEL	BLR
2,019,770,095	1	BOM	MAA
2,019,770,675	2	MAA	DEL
2,019,770,213	1	SXR	IXJ
2,019,770,213	2	IXJ	DEL
2,019,770,213	3	DEL	BOM
2,019,770,213	4	BOM	SXR
2,019,770,816	2	DEL	MAA
2,019,770,816	3	MAA	IXC
OUTPUT					Rule
KM	Leg	Org	Dest	OUTPUT
2,019,769,184	1	BOM	DEL	BOM - DEL - BLR	KM are same for Leg 1 & 2 hence Org and Dest combined in column E
2,019,769,184	2	DEL	BLR
2,019,770,095	1	BOM	MAA	BOM - MAA	KM is only one and not matching with any one hence Org and Dest taken as it is in column E
2,019,770,675	2	MAA	DEL	MAA - DEL	KM is only one and not matching with any one hence Org and Dest taken as it is in column E
2,019,770,213	1	SXR	IXJ	SXR - IXJ - DEL - BOM - SXR	KM are same for Leg 1, 2, 3 & 4 hence Org and Dest combined in column E
2,019,770,213	2	IXJ	DEL
2,019,770,213	3	DEL	BOM
2,019,770,213	4	BOM	SXR
2,019,770,816	2	DEL	MAA	DEL - MAA - IXC	KM are same for Leg 2 & 3 hence Org and Dest combined in column E
2,019,770,816	3	MAA	IXC
2,019,770,800	6	KLH	BOM	KLH - BOM	KM is only one and not matching with any one hence Org and Dest taken as it is in column E

Thank You,

Shan

[shan]

Please find attached excel for more understanding...

[p45cal]

try this in your sample file:

Sub blah()
Sheets("Sheet1").Copy After:=Sheets(Sheets.Count)  'delete this line later.
Dim SelRng As Range
Range("A1").CurrentRegion.Select  'delete this line if it's a nuisance.
On Error Resume Next
Set SelRng = Application.InputBox("Select the area to process (4 columns)" & vbLf & "Include column headers (KM, Leg, Org, Dest)" & vbLf & vbLf & "Make sure there's nothing you want to keep in the single column directly to the right of your selection.", "Area to process", Selection.Address, Type:=8)
On Error GoTo 0
If Not SelRng Is Nothing Then
  Set myrng = SelRng.Resize(, 5)
  myrng.Subtotal GroupBy:=1, Function:=xlCount, TotalList:=Array(5), SummaryBelowData:=0
  Set ResultsRng = myrng.Resize(myrng.Rows.Count - 2, 1).Offset(2, 4).SpecialCells(xlCellTypeFormulas, 1).Offset(1)

  With ResultsRng
    For i = 1 To .Areas.Count
      mystr = .Areas(i).Offset(, -2).Value
      If i = .Areas.Count Then
        Set rngmyStr2 = .Areas(i).Offset(, -1).Resize(myrng.Cells(myrng.Cells.Count).Row - .Areas(i).Row + 1)  'range the 2nd bit of the result
      Else
        Set rngmyStr2 = Range(.Areas(i).Offset(, -1), .Areas(i + 1).Offset(-2, -1))  'range of the 2nd bit of the result
      End If
      If rngmyStr2.Rows.Count > 1 Then
        myStr2 = Application.Transpose(rngmyStr2.Value)
        zzz = Join(Array(mystr, Join(Application.Transpose(rngmyStr2.Value), " - ")), " - ")
      Else
        zzz = .Areas(i).Offset(, -2).Value & " - " & .Areas(i).Offset(, -1).Value
      End If
      .Areas(i).Value = zzz
    Next i
  End With
  myrng.RemoveSubtotal
  myrng.Cells(1).Offset(, 4).Select
Else
  MsgBox "Process aborted"
End If
End Sub

Note that it relies entirely on changes in the values in column A, so if there happen to be 2 trips with the same values next to each other it will count them as one.
See comments in the code about the first line copying sheet1. Also attachment.

[p45cal]

oh groan, you've cross posted this without providing links (and you seem to have done this routinely in the past).
http://www.mrexcel.com/forum/excel-q...nd-column.html
Please please supply links to your other cross posts when you do this; read this to see why: http://www.excelguru.ca/content.php?184
All forums have the same rules on this.

[shan]

Thank you Sir..

I am sorry for the cross posted... I thought its a two different websites will help me to create the macro. I am really sorry. Hence onwards the same will not be repeated.

Thank you so much for making me understanding the concept of Cross posting.!!

[shan]

Thank you so much for your resolution..... it is working as desired...!!!

[Aussiebear]

G'day Shan, For your benefit, please be aware the the VBA community consists of members who are multi forum members or contributors. Hence its all to easy for cross posted issues to be located. I would have it as a guess that almost all sites have as part of their "rules", one which deals with the issue of cross posting. Please take the opportunity to read the rules and then you'll understand why cross posting without the links, irritates a significant majority of the VBA community.

[shan]

Yes Sir.. I agree with you.. the same will not be repeated from me again.. i appolized for the same.