Consolidating cells

[ForSale]

I have a small database on Excel, more of a list of agent's names an
info. anyway, beside their name is 9 columns of different areas tha
they could be trained in. if that agent is trained, they have an 'x
in the corresponding column. when the user inputs a new agent with th
userform it adds that agent to the next row.
Here's what i need:
i need a macro that will search for duplicate entries, then consolidat
them. in a sense, i don't want the same i.d. number (column C
repeated, but i want to keep the new 'x' in columns D-L.
let me know if i need to elaborate a little more.
thanks in advance

 

[ForSale]

any thoughts

 

[Dave Peterson]

This will destroy your data if it isn't correct--so either run it against a
backup copy or save without closing:

Option Explicit
Sub testme()
Dim wks As Worksheet
Dim myRng as Range
Dim iRow As Long
Dim FirstRow As Long
Dim LastRow As Long
Dim iCol As Long

Set wks = Worksheets("sheet1")

With wks
FirstRow = 2 'headers in row 1???
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set myRng = .Range(.Cells(FirstRow, "A"), .Cells(LastRow, "L"))

With myRng
.Sort key1:=.Cells(1), order1:=xlAscending, header:=xlNo
End With

For iRow = LastRow To FirstRow + 1 Step -1
If .Cells(iRow, "A").Value = .Cells(iRow - 1, "A").Value Then
For iCol = 2 To 12 'B to L
If .Cells(iRow, iCol).Value = "" Then
'do nothing
Else
.Cells(iRow - 1, iCol).Value = .Cells(iRow, iCol).Value
End If
Next iCol
.Rows(iRow).Delete
End If
Next iRow
End With

End Sub

 

[Norman Jones]

This will destroy your data if it isn't correct--so either run it against
a

backup copy or save without closing:

I think, for the second option, Dave meant:

Close without saving


---
Regards
Norman


..com

 

[Dave Peterson]

Stupid fingers!

Correction for the thanks!

I think, for the second option, Dave meant:

Close without saving

---
Regards
Norman

.com

 

[ForSale]

Thanks Dave and Norman,
That worked, however, instead of deleting duplicate rows, i need t
consolidate them. i'll try to elaborate a little more.
at the place that i work everyone can be trained in up to 9 differen
things. i am working on a small workbook to try to keep track of this
so, column a is last name, b is first name and c is ID. columns D:
are the different areas in which an agent can be trained. when th
user inputs a new agent after a training class, by way of a userform
it just adds it to the bottom. then when you sort by ID, there are
lot of duplicates, however, it is only the ID number that is excactl
dupliacted.
for instance. john smith got trained in area 3. the user will ente
that on the userform and it will enter on a4 john, b4 smith, c4 1234
d4 x. then the next week john smith gets trained in area 63 (which i
in column i). now the user does the same thing, except the userfor
returns an 'x' in column i on the next empty row. so now john smith i
on there twice. when i sort by ID, it will put the john smith 123
that is trained in 3 on row 4 and the john smith 1234 that is traine
in 63 on row 5. these are the same person, though. so i want a macr
that will see the duplicate and consolidate so that on row 4 is joh
smith 1234 with an 'x' in column D and I.
thanks for reading through all of this, with how long it is and all.
and thanks in advance for any help

 

[Dave Peterson]

I think I'd use the ID column as my sort (column C, right?):

Option Explicit
Sub testme()
Dim wks As Worksheet
Dim myRng As Range
Dim iRow As Long
Dim FirstRow As Long
Dim LastRow As Long
Dim iCol As Long

Set wks = Worksheets("sheet1")

With wks
FirstRow = 2 'headers in row 1???
LastRow = .Cells(.Rows.Count, "c").End(xlUp).Row
'adjust "L" to extend to the last column
Set myRng = .Range(.Cells(FirstRow, "A"), .Cells(LastRow, "L"))

With myRng
.Sort key1:=.Columns(3), order1:=xlAscending, header:=xlNo
End With

For iRow = LastRow To FirstRow + 1 Step -1
If .Cells(iRow, "C").Value = .Cells(iRow - 1, "C").Value Then
For iCol = 4 To 12 'd to L
If .Cells(iRow, iCol).Value = "" Then
'do nothing
Else
.Cells(iRow - 1, iCol).Value = .Cells(iRow, iCol).Value
End If
Next iCol
.Rows(iRow).Delete
End If
Next iRow
End With

End Sub


I think the basic code is ok. It's just that I used column A instead of column
C.

And adjust these two lines to match your data:
Set myRng = .Range(.Cells(FirstRow, "A"), .Cells(LastRow, "L"))
and
For iCol = 4 To 12 'd to L

 

[ForSale]

Doug,
i have to say, i have only been using Excel and VBA for about 2 or
years. i am still a novice by all means. however, i have seem som
pretty amazing stuff on Excel. this is truly one of the mos
incredible feats that i've ever seen. i have to admit that i was
little nervous about trying this (not becuase i don't trust you, bu
becuase i didn't think that i explained what i wanted very well) so
tested it on a copy. it worked perfectly. i compared the test to th
original and there are no duplicates and every peice of info stayed
nothing was lost!
thank you so much and stuff.
you're the best

 

[Dave Peterson]

I'm sure Doug appreciates the thanks <vbg>.

Doug,
i have to say, i have only been using Excel and VBA for about 2 or 3
years. i am still a novice by all means. however, i have seem some
pretty amazing stuff on Excel. this is truly one of the most
incredible feats that i've ever seen. i have to admit that i was a
little nervous about trying this (not becuase i don't trust you, but
becuase i didn't think that i explained what i wanted very well) so i
tested it on a copy. it worked perfectly. i compared the test to the
original and there are no duplicates and every peice of info stayed,
nothing was lost!
thank you so much and stuff.
you're the best!

 

[Norman Jones]

Hi Dave,


I think you got a doubly raw deal. Firstly, you are asked share thanks with
me although I made no contribution, and then this interloper Doug steals
your entire thunder!

Regards,
Norman

 

[ForSale]

correction for the thanks nathan.
i'm an idiot that's been at work for a long time racking my brain ove
opening a file

 

[Dave Peterson]

Either ForSale is really funny or really weird (or I guess both!).

Hi Dave,

I think you got a doubly raw deal. Firstly, you are asked share thanks with
me although I made no contribution, and then this interloper Doug steals
your entire thunder!

Regards,
Norman