View Full Version : Combining matching values.
Robert87
01-11-2016, 05:39 AM
Hello.
Could anyone help me figure this out. I donīt even know if itīs possible, but itīs worth a shot.
I want to make a macro that combines a certain columnīs values of other columnīs values match. Column B should always be the column that has it values added, as long as Colum A, C and D all match with each other.
And I need to be able to change data in thoose columns as I please.
15138
Iīve attached a big example post, and Iīll write a smaller example down below.
58 650
2
1 485
B310-1016
58 650
2
1 485
B310-1016
58 650
4
1 380
B310-1011
58 650
4
1 380
B310-1011
I wanīt thoose lines to read:
58 650
4
1 485
B310-1016
58 650
8
1 380
B310-1011
Help with this issue would be much appreciated.
Paul_Hossler
01-11-2016, 07:08 AM
Here's a simple way. Sorts the data first, and then adds col 2 and deletes from the bottom up
A pivot table would probably also work without a macro
Option Explicit
Sub PHH()
Dim rData As Range
Dim iRow As Long
Set rData = ActiveSheet.Cells(1, 1).CurrentRegion
Application.ScreenUpdating = False
With ActiveSheet
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=rData.Columns(1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.Sort.SortFields.Add Key:=rData.Columns(3), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.Sort.SortFields.Add Key:=rData.Columns(4), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.Sort.SetRange rData
.Sort.Header = xlGuess
.Sort.MatchCase = False
.Sort.Orientation = xlTopToBottom
.Sort.SortMethod = xlPinYin
.Sort.Apply
For iRow = rData.Rows.Count - 1 To 1 Step -1
If .Cells(iRow + 1, 1).Value = .Cells(iRow, 1).Value And _
.Cells(iRow + 1, 3).Value = .Cells(iRow, 3).Value And _
.Cells(iRow + 1, 4).Value = .Cells(iRow, 4).Value Then _
.Cells(iRow, 2).Value = .Cells(iRow, 2).Value + .Cells(iRow + 1, 2).Value
.Rows(iRow + 1).EntireRow.Delete
End If
Next iRow
End With
Application.ScreenUpdating = True
End Sub
Robert87
01-11-2016, 07:59 AM
Thanks alot! Works perfectly!
Robert87
05-04-2016, 01:27 PM
Iīve been using this script for a while now and it works like a charm.
Could I make this script only run in a defined area? Letīs say I wanīt it only to use the cells in C5:H20. Is that possible?
Paul_Hossler
05-04-2016, 03:46 PM
Without seeing the data layout, a GUESS would be ...
Set rData = ActiveSheet.Range("C5").CurrentRegion
Robert87
05-04-2016, 08:15 PM
With that I canīt get it to skip the first few rows.
Natasha
05-05-2016, 02:32 AM
Thank you Paul its a great help
Paul_Hossler
05-05-2016, 02:22 PM
As I said "Without seeing the data layout, ... "
How about posting a WB or at least a screen shot?
Robert87
05-05-2016, 02:39 PM
Ohh right, ofcourse. Sorry.
Here is my workbook.
16106
What I need is:
Under each profile I want the amount to be combined if both the Lenght and Type match.
Paul_Hossler
05-05-2016, 04:00 PM
Sorry, but the data in that WB doesn't look anything like the data in your #1 post, the layout is different, the data format is different, plus there is data in hidden columns that you might want to keep
Can you repeat in words using cell references what you're looking to do?
16107
Robert87
05-06-2016, 02:26 AM
Ohh. Sorry. I forgot to hide that sheet.
Itīs the sheet "Bearbetning" I want help with.
16112
Under "Profile 1" I want the values in column B to be combined if both C and D values match.
Under "Profile 2" I want the values in column F to be combined if both G and H values match.
Under "Profile 3" I want the values in column J to be combined if both K and L values match.
Under "Profile 4" I want the values in column N to be combined if both O and P values match.
Under "Profile 5" I want the values in column Q to be combined if both R and S values match.
And in all cases itīs the rows 12 to 198 that are being used.
Donīt worry about hidden data, if you want you can just copy the cells and paste them as values.
Thatīs what I need my program to do, if itīs possible.
Paul_Hossler
05-06-2016, 06:59 AM
Maybe something like this
Option Explicit
Dim wsOrders As Worksheet, wsSummary As Worksheet
Sub GenerateSummary()
'setup
Application.ScreenUpdating = False
Set wsOrders = Worksheets("Bearbetning")
'delete old
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("Summary").Delete
Application.DisplayAlerts = True
On Error GoTo 0
'create summary for orders to get headers
wsOrders.Copy After:=wsOrders
Set wsSummary = ActiveSheet
wsSummary.Name = "Summary"
'do profiles
Call pvtProfiles(wsSummary.Range("B12"))
Call pvtProfiles(wsSummary.Range("F12"))
Call pvtProfiles(wsSummary.Range("J12"))
Call pvtProfiles(wsSummary.Range("N12"))
Call pvtProfiles(wsSummary.Range("Q12"))
'cleanup
Application.ScreenUpdating = True
End Sub
Private Sub pvtProfiles(R As Range)
Dim rLast As Range, rSort As Range
Dim iRow As Long
'find last cell of 3rd column
Set rLast = R.Offset(0, 2).End(xlDown)
Range(R, rLast).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Do While rLast.Value = 0
Set rLast = rLast.Offset(-1, 0)
Loop
Set rSort = Range(R, rLast)
'sort by 2nd and 3rd col
With wsSummary.Sort
.SortFields.Clear
.SortFields.Add Key:=rSort.Columns(2), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SortFields.Add Key:=rSort.Columns(3), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange rSort
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'summary from bottom up
With rSort
For iRow = .Rows.Count To 2 Step -1
If .Cells(iRow - 1, 2).Value = .Cells(iRow, 2).Value And .Cells(iRow - 1, 3).Value = .Cells(iRow, 3).Value Then
.Cells(iRow - 1, 1).Value = .Cells(iRow - 1, 1).Value + .Cells(iRow, 1).Value
.Rows(iRow).Delete
End If
Next iRow
End With
End Sub
PS - it is possilbe to just use the WS 'Bearbetning' to summerize, but I really don't like to destroy the input source like that
Robert87
05-07-2016, 12:41 PM
That script did exactly what I needed.
Thank you very much Paul_Hossler!
Much appreciated!
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.