Segregation Solution Needed

samitnair · Feb 24, 2011

Thanks to all Mr excel members for supporting me. Am trying to help myself from a very time consuming work and would appreciate ur valuable suggestions.

As per the sheet above i would need to find the individual belt length, price and Conveyor No according to belt width, type of fabric, belt designation, belt covers and belt

grade.

I am expecting the result like below

All the values under the heading keeps changing as it is custom made product so i cant keep a table to refer.

I like to know any solution or any workaround...It would be a great help for me to save a lot of time manually finding the belt and copy pasting.

Thanks

Jerry Sullivan · Feb 25, 2011

Hi Samitnair,

Not sure that I follow exactly how you want this to work.

Comparing the two images, it looks like you want to remove rows that have certain field values duplicated, but then concatenate the duplicates in Conveyor no and Indiv length fields.

But in reading....

samitnair said:
As per the sheet above i would need to find the individual belt length, price and Conveyor No according to belt width, type of fabric, belt designation, belt covers and belt grade.

....it sounds like you want some kind of lookup that takes inputs (belt width, type of fabric, belt designation, belt covers and belt grade) and finds rows that match those values.

Will you please clarify?

samitnair · Feb 25, 2011

Hi

Kindly excuse me for making the question quite complicated....You are absolutely right, am trying to reduce the duplicate in specifications and combine ony the values of conveyor numbers and the belt length to one cell or row each

The below mentioned headings are specifications of conveyors.(which keeps repeating/duplicating.)
1. Belt Width
2. Type of Fabric
3. Belt Designation
4. Belt Covers
5. Cover Grade

but if you observ the conveyor no and the belt length keeps changing (individual) values.
So, Am trying to finding that how many individual conveyor no and belt length are there under a particular specification

the final result would be like (am using [ ] to diffrentiate columns)

[Belt Width] [Type of Fabric] [Belt Designation] [Belt Covers] [Cover Grade] [Conveyor No.] [Indv Length]

[1600] [NN] [1000/5] [8/4] [FR] [TT4C1, TT4C2, TT4C3, TT4C4] [251, 244, 264, 264] (FIGURE 1 ROW # A8, A9, A10)
[1600] [NN] [400/4] [8/4] [FR] [J3C3, J21AC3,CJ4C1] [102, 100,105] (FIGURE 1 ROW # A12, A13, A14)
[1400] [NN] [400/4] [8/4] [M24] [J21AC1, J21AC2] [101, 111] (FIGURE 1 ROW # A4, A5)

THE SHEET WHICH U ARE VIEWING IS A VERY SMALL PART..WE GET SHEETS OF AROUND 900 - 2000 SPECIFICATION SO U CAN IMAGINE THE TIME AND RISK OF ERROR IN THIS JOB.....AM NEW TO THIS AND I WOULD LIKE TO AUTOMATE AND REDUCE THE RISK TO 0%. Please let me know if ur need more clarification.

thank you for helping me...

Jerry Sullivan · Feb 26, 2011

You could try something like the code below. It assumes you have your source data on "Sheet1" with Headers you listed in Cells "A1:G1".
It also assumes you have an empty sheet named "Combined".

The process is:

Copy all source data to Sheet Combined
Sort by the first 5 Columns
Working from the last Row up, build the lists of duplicates.
Remove duplicates

Code:

Sub Make_Combined_Report()
    Dim strData As String: strData = "Sheet1"
    Dim strReport As String: strReport = "Combined"
    Dim strCodeLast As String, strCodeCurr As String
    Dim lngLastRow As Long, lngRow As Long
 
    Application.ScreenUpdating = False
    Worksheets(strData).Range("A:G").Copy _
        Destination:=Worksheets(strReport).Range("A1")
 
    With Worksheets(strReport)
        .Activate
        lngLastRow = .Range("A" & .Rows.Count).End(xlUp).Row
        With .Sort
            .SortFields.Clear
            .SortFields.Add Key:=Range("A1"), _
                SortOn:=xlSortOnValues, Order:=xlAscending, _
                DataOption:=xlSortNormal
            .SortFields.Add Key:=Range("B1"), _
                SortOn:=xlSortOnValues, Order:=xlAscending, _
                DataOption:=xlSortNormal
            .SortFields.Add Key:=Range("C1"), _
                SortOn:=xlSortOnValues, Order:=xlAscending, _
                DataOption:=xlSortNormal
            .SortFields.Add Key:=Range("D1"), _
                SortOn:=xlSortOnValues, Order:=xlAscending, _
                DataOption:=xlSortNormal
            .SortFields.Add Key:=Range("E1"), _
                SortOn:=xlSortOnValues, Order:=xlAscending, _
                DataOption:=xlSortNormal
            .SetRange Worksheets(strReport).Range("A1:G" & lngLastRow)
            .Header = xlYes
            .Orientation = xlTopToBottom
            .Apply
            .SortFields.Clear
        End With
 
        strCodeLast = ""
        For lngRow = lngLastRow To 2 Step -1
            strCodeCurr = .Cells(lngRow, 1) & .Cells(lngRow, 2) _
                & .Cells(lngRow, 3) & .Cells(lngRow, 4) & .Cells(lngRow, 5)
            If strCodeCurr = strCodeLast Then
                .Cells(lngRow, 6) = .Cells(lngRow, 6) & "," _
                    & .Cells(lngRow + 1, 6)
                .Cells(lngRow, 7) = .Cells(lngRow, 7) & "," _
                    & .Cells(lngRow + 1, 7)
            Else
                strCodeLast = strCodeCurr
            End If
        Next
        .Range("A:G").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5), _
            Header:=xlYes
    End With
End Sub

Please let me know if that gives you the results you wanted.

samitnair · Feb 28, 2011

Hi

Thanks a million for your response and it worked perfectly fine....I just created this code to automatically create a sheet named "combined but it gives me a error Syntax error 9

Sub Combine()

On Error Resume Next
Sheets(1).Select
Worksheets.Add

Sheets(1).Name = "Combined"

End Sub

Just correct me if i went wrong

Jerry Sullivan · Feb 28, 2011

I'm happy to hear that worked for you.

The code you posted doesn't look like it should generate a Syntax error...possibly you have a syntax error elsewhere in your VBA project that is being caught by the compiler?

Even if you find and fix that error, that code might not give you the intended result. If you already have a sheet named "Combined" it will add a new first sheet, but won't be able to rename it.

The result will be that you have an extra sheet you didn't intend and "Combined" will not be your first sheet.

You could try this instead...

Rich (BB code):

Sub Make_Sheet_Combined()
    On Error Resume Next
    If (IsError(Sheets("Combined").Activate)) Then
        Worksheets.Add before:=Sheets(1)
        ActiveSheet.Name = "Combined"
    Else 'sheetname already exists
       Sheets("Combined").Move before:=Sheets(1)
    End If
End Sub

Good luck!

samitnair · Feb 28, 2011

THANKS FOR YOUR SUPPORT....I TRIED A LOT OF MODIFICATIONS AND IT EVEN WORKS FOR MY OTHER TEDIOUS TASKS.....

samitnair · Mar 1, 2011

Hey Jerry....if you really don't mind could you please go through this code and please modify....."I would'nt ask you anymore questions in this decade"

Purpose of this code: I am trying to combine the data from Sheet 1,2,3 into to sheet "AIO" which are in the same workbook. But the code only supports creating a new sheet (AIO) every time i run the code...but i would like only the sheet to be updated..... CAN this be done???

Sub Combine()
Dim J As Integer
On Error Resume Next
Sheets(1).Select
Worksheets.Add
Sheets(1).Name = "AIO"
Sheets(2).Activate
Range("A1").EntireRow.Select
Selection.Copy Destination:=Sheets(1).Range("A1")
For J = 2 To Sheets.Count
Sheets(J).Activate
Range("A1").Select
Selection.CurrentRegion.Select
Selection.Offset(3, 0).Resize(Selection.Rows.Count - 1).Select
Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)
Next
End Sub

Thanks in adv

Jerry Sullivan · Mar 1, 2011

Hi Samitnair,
Best to start another thread for a new topic. That will help others who have a similar question and you are more likely to get a prompt response.
I'll respond to your new thread if someone else doesn't do that first.
Kind regards,

samitnair · Mar 3, 2011

Hi Jerry.....

U are right a new thread would be useful for future reference...

http://www.mrexcel.com/forum/showthread.php?t=533131

thanks

Segregation Solution Needed

samitnair

Board Regular

Excel Facts

Jerry Sullivan

MrExcel MVP

samitnair

Board Regular

Jerry Sullivan

MrExcel MVP

samitnair

Board Regular

Jerry Sullivan

MrExcel MVP

samitnair

Board Regular

samitnair

Board Regular

Jerry Sullivan

MrExcel MVP

samitnair

Board Regular

Similar threads

Forum statistics

Share this page

Segregation Solution Needed

Board Regular

Excel Facts

MrExcel MVP

Board Regular

MrExcel MVP

Board Regular

MrExcel MVP

Board Regular

Board Regular

MrExcel MVP

Board Regular

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock