VBA. identify in different rows if data is the same in one cell and give same serial number

A

Ambre

New Member
Joined
Sep 12, 2013
Messages
23
Dear all,

What I am trying to do is:
When two rows have the same Project ID, then they have the same serial number.
I could have 2 or more rows with the same project ID.

Cannot write a code that works. I think the best is to use If Then Else.

See the tables below for better understanding.

Many thanks for your help.

Ambre
Excel 2010
Windows XP
[TABLE="width: 561"]
<TBODY>[TR]
[TD="class: xl474, width: 107, bgcolor: transparent"]What I have
[/TD]
[TD="width: 63, bgcolor: transparent"][/TD]
[TD="width: 359, bgcolor: transparent"][/TD]
[TD="width: 115, bgcolor: transparent"][/TD]
[TD="width: 105, bgcolor: transparent"][/TD]
[/TR]
[TR]
[TD="class: xl484, width: 107, bgcolor: silver"]Serial number
[/TD]
[TD="class: xl484, width: 63, bgcolor: silver"]AAA
[/TD]
[TD="class: xl484, width: 359, bgcolor: silver"]BBB
[/TD]
[TD="class: xl484, width: 115, bgcolor: silver"]Project ID
[/TD]
[TD="class: xl484, width: 105, bgcolor: silver"]Project Name
[/TD]
[/TR]
[TR]
[/TR]
[TR]
[TD="class: xl473, bgcolor: transparent, align: right"]1320
[/TD]
[TD="class: xl478, width: 63, bgcolor: transparent"]AL
[/TD]
[TD="class: xl479, width: 359, bgcolor: transparent"]BBBC
[/TD]
[TD="class: xl480, width: 115, bgcolor: white"]EXAMPLE0123
[/TD]
[TD="class: xl479, width: 105, bgcolor: transparent"]ALA
[/TD]
[/TR]
[TR]
[TD="class: xl473, bgcolor: transparent, align: right"]1319
[/TD]
[TD="class: xl481, width: 63, bgcolor: white"]AM
[/TD]
[TD="class: xl479, width: 359, bgcolor: transparent"]BBBD
[/TD]
[TD="class: xl480, width: 115, bgcolor: white"]EXAMPLE0124
[/TD]
[TD="class: xl479, width: 105, bgcolor: transparent"]ABA
[/TD]
[/TR]
[TR]
[TD="class: xl473, bgcolor: transparent, align: right"]1318
[/TD]
[TD="class: xl482, width: 63, bgcolor: white"]AN
[/TD]
[TD="class: xl479, width: 359, bgcolor: transparent"]BBBE
[/TD]
[TD="class: xl480, width: 115, bgcolor: white"]EXAMPLE0125
[/TD]
[TD="class: xl479, width: 105, bgcolor: transparent"]ACA
[/TD]
[/TR]
[TR]
[TD="class: xl473, bgcolor: transparent, align: right"]1317
[/TD]
[TD="class: xl478, width: 63, bgcolor: transparent"]AO
[/TD]
[TD="class: xl479, width: 359, bgcolor: transparent"]BBBE
[/TD]
[TD="class: xl480, width: 115, bgcolor: white"]EXAMPLE0126
[/TD]
[TD="class: xl479, width: 105, bgcolor: transparent"]AKA
[/TD]
[/TR]
[TR]
[TD="class: xl473, bgcolor: transparent, align: right"]1316
[/TD]
[TD="class: xl481, width: 63, bgcolor: white"]AP
[/TD]
[TD="class: xl479, width: 359, bgcolor: transparent"]BBBA
[/TD]
[TD="class: xl480, width: 115, bgcolor: white"]EXAMPLE0127
[/TD]
[TD="class: xl483, width: 105, bgcolor: transparent"]APA
[/TD]
[/TR]
[TR]
[TD="class: xl473, bgcolor: transparent, align: right"]1315
[/TD]
[TD="class: xl482, width: 63, bgcolor: white"]AQ
[/TD]
[TD="class: xl479, width: 359, bgcolor: transparent"]BBBC
[/TD]
[TD="class: xl480, width: 115, bgcolor: white"]EXAMPLE0123
[/TD]
[TD="class: xl483, width: 105, bgcolor: transparent"]AAL
[/TD]
[/TR]
[TR]
[TD="class: xl473, bgcolor: transparent, align: right"]1314
[/TD]
[TD="class: xl478, width: 63, bgcolor: transparent"]AR
[/TD]
[TD="class: xl479, width: 359, bgcolor: transparent"]BBBD
[/TD]
[TD="class: xl480, width: 115, bgcolor: white"]EXAMPLE0129
[/TD]
[TD="class: xl483, width: 105, bgcolor: transparent"]ANA
[/TD]
[/TR]
[TR]
[TD="class: xl473, bgcolor: transparent, align: right"]1313
[/TD]
[TD="class: xl481, width: 63, bgcolor: white"]AS
[/TD]
[TD="class: xl479, width: 359, bgcolor: transparent"]BBBF
[/TD]
[TD="class: xl480, width: 115, bgcolor: white"]EXAMPLE0130
[/TD]
[TD="class: xl483, width: 105, bgcolor: transparent"]ARA
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[/TR]
[TR]
[TD="class: xl474, bgcolor: transparent, colspan: 3"]What I would like (forget about the color it was only to show what is important)
[/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[/TR]
[TR]
[TD="class: xl484, width: 107, bgcolor: silver"]Serial number
[/TD]
[TD="class: xl484, width: 63, bgcolor: silver"]AAA
[/TD]
[TD="class: xl484, width: 359, bgcolor: silver"]BBB
[/TD]
[TD="class: xl484, width: 115, bgcolor: silver"]Project ID
[/TD]
[TD="class: xl484, width: 105, bgcolor: silver"]Project Name
[/TD]
[/TR]
[TR]
[TD="class: xl475, bgcolor: #c4d79b, align: right"]1315
[/TD]
[TD="class: xl476, bgcolor: transparent"]AL
[/TD]
[TD="class: xl476, bgcolor: transparent"]BBBC
[/TD]
[TD="class: xl477, bgcolor: #c4d79b"]EXAMPLE0123
[/TD]
[TD="class: xl476, bgcolor: transparent"]ALA
[/TD]
[/TR]
[TR]
[TD="class: xl473, bgcolor: transparent, align: right"]1319
[/TD]
[TD="class: xl476, bgcolor: transparent"]AM
[/TD]
[TD="class: xl476, bgcolor: transparent"]BBBD
[/TD]
[TD="class: xl476, bgcolor: transparent"]EXAMPLE0124
[/TD]
[TD="class: xl476, bgcolor: transparent"]ABA
[/TD]
[/TR]
[TR]
[TD="class: xl473, bgcolor: transparent, align: right"]1318
[/TD]
[TD="class: xl476, bgcolor: transparent"]AN
[/TD]
[TD="class: xl476, bgcolor: transparent"]BBBE
[/TD]
[TD="class: xl476, bgcolor: transparent"]EXAMPLE0125
[/TD]
[TD="class: xl476, bgcolor: transparent"]ACA
[/TD]
[/TR]
[TR]
[TD="class: xl473, bgcolor: transparent, align: right"]1317
[/TD]
[TD="class: xl476, bgcolor: transparent"]AO
[/TD]
[TD="class: xl476, bgcolor: transparent"]BBBE
[/TD]
[TD="class: xl476, bgcolor: transparent"]EXAMPLE0126
[/TD]
[TD="class: xl476, bgcolor: transparent"]AKA
[/TD]
[/TR]
[TR]
[TD="class: xl473, bgcolor: transparent, align: right"]1316
[/TD]
[TD="class: xl476, bgcolor: transparent"]AP
[/TD]
[TD="class: xl476, bgcolor: transparent"]BBBA
[/TD]
[TD="class: xl476, bgcolor: transparent"]EXAMPLE0127
[/TD]
[TD="class: xl476, bgcolor: transparent"]APA
[/TD]
[/TR]
[TR]
[TD="class: xl475, bgcolor: #c4d79b, align: right"]1315
[/TD]
[TD="class: xl476, bgcolor: transparent"]AQ
[/TD]
[TD="class: xl476, bgcolor: transparent"]BBBC
[/TD]
[TD="class: xl477, bgcolor: #c4d79b"]EXAMPLE0123
[/TD]
[TD="class: xl476, bgcolor: transparent"]AAL
[/TD]
[/TR]
[TR]
[TD="class: xl473, bgcolor: transparent, align: right"]1314
[/TD]
[TD="class: xl476, bgcolor: transparent"]AR
[/TD]
[TD="class: xl476, bgcolor: transparent"]BBBD
[/TD]
[TD="class: xl476, bgcolor: transparent"]EXAMPLE0129
[/TD]
[TD="class: xl476, bgcolor: transparent"]ANA
[/TD]
[/TR]
[TR]
[TD="class: xl473, bgcolor: transparent, align: right"]1313
[/TD]
[TD="class: xl476, bgcolor: transparent"]AS
[/TD]
[TD="class: xl476, bgcolor: transparent"]BBBF
[/TD]
[TD="class: xl476, bgcolor: transparent"]EXAMPLE0130
[/TD]
[TD="class: xl476, bgcolor: transparent"]ARA
[/TD]
[/TR]
</TBODY>[/TABLE]
 
Sort by date Sort by votes
My try, at least the beggining

Public Sub test()

'identify column
Dim ProjectID As Integer
Dim ProjectID_column As Integer
For ProjectID = 1 To 200
If Worksheets("Purchasing Plan").Cells(11, ProjectID) = "Project ID" Then
ProjectID_column = ProjectID
End If

Next

Dim dataRange As Range
Dim oneCell As Range
Set dataRange = Range(.Cells(15, ProjectID_column), .Cells(.Rows.Count, 15).End(xlUp))

I do not know what do to next and I could not find the solution in the forums I visited
 
Upvote 0
Hi Ambre

Try this
Code: 
Option Explicit
Sub Find_Dups()
    Dim LR As Long
    Dim Rng As Range, Cel As Range
    Dim ws As Worksheet
    Set ws = Sheets("Sheet1") '<----Change Sheet Name as required
    With ws
        LR = .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), SearchOrder:=xlByRows, _
                SearchDirection:=xlPrevious).Row
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=Range("D2:D" & LR), _
                SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With .Sort
            .SetRange Range("A1:E" & LR)
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        For Each Cel In .Range("D2:D" & LR)
            If Cel.Value = Cel.Offset(1, 0).Value Then
                Cel.Offset(1, -3).Value = Cel.Offset(0, -3).Value
            End If
        Next Cel
    End With
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Question Question
Excel macro for Remove comma's and spaces from a cell and place the data in different cell
Replies
3
Views
1K
JEC
JEC

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top