PDA

View Full Version : Sorting table with Duplicates



RebaS
06-07-2019, 09:32 AM
I'm trying to learn VBA and I don't where to start with this. I think this shouldn't be difficult, but I'm just going around in circles with my attempts.
I'm trying to write a macro to sort data in a table. I need to delete the duplicates in only column A without affecting the location of the remaining text.
What I have:



Employee
Certification
Series
CATEGORY


Joe
1/1/19
DS
DEMO


Joe
8/7/18
EE
CLASS


Joe
3/14/19
EE
OBSERVATION


Claire
1/5/19
K7
CLASS


Claire
2/17/19
DS
DEMO


Mary
6/9/18
RG
WRITTEN


William
11/28/18
EM
WRITTEN























What I'm trying to do:


Employee
Certification
Series
CATEGORY




1/1/19
DS
DEMO




8/7/18
EE
CLASS




3/14/19
EE
OBSERVATION


Claire
1/5/19
K7
CLASS




2/17/19
DS
DEMO


Mary
6/9/18
RG
WRITTEN


William
11/28/18
EM
WRITTEN













I greatly appreciate your help!

Paul_Hossler
06-07-2019, 02:10 PM
It's the For iName loop that does the work



Option Explicit
Sub SortAndFormat()
Dim wsData As Worksheet
Dim rData As Range, rDataWithoutHeaders As Range
Dim iName As Long

Application.ScreenUpdating = False

Set wsData = Worksheets("Sheet1")

Set rData = wsData.Cells(1, 1).CurrentRegion
Set rDataWithoutHeaders = rData.Cells(2, 1).Resize(rData.Rows.Count - 1, rData.Columns.Count)


With wsData.Sort
.SortFields.Clear
.SortFields.Add Key:=rDataWithoutHeaders.Columns(1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SortFields.Add Key:=rDataWithoutHeaders.Columns(2), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange rData
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With


For iName = rData.Rows.Count To 2 Step -1
If rData.Cells(iName, 1).Value = rData.Cells(iName - 1, 1) Then rData.Cells(iName, 1).ClearContents
Next


Application.ScreenUpdating = True
End Sub

Bob Phillips
06-07-2019, 03:08 PM
Why not just use conditional formatting with a formula of
=COUNTIF($A:$A,$A2)>1
and set the font to white.

Artik
06-08-2019, 12:16 AM
Set rDataWithoutHeaders = rData.Cells(2, 1).Resize(rData.Rows.Count - 1, rData.Columns.Count)
If in the defined range we do not change the number of columns, then this parameter does not have to be given (and similarly for the rows):
Set rDataWithoutHeaders = rData.Offset(1).Resize(rData.Rows.Count - 1)
'or in the case of rows
Set rDataWithoutHeadersAndLastCol = rData.Offset(1).Resize(, rData.Columns.Count - 1)


Why not just use CF (...) and set the font to white.Some printers can not handle this task. Although we see "nothing" ;) on the screen, they will show the contents of the cell on a sheet of paper.

Artik

Paul_Hossler
06-08-2019, 05:58 AM
If in the defined range we do not change the number of columns, then this parameter does not have to be given (and similarly for the rows):


I just consider it more robust to do it this way

I always like to spell things out

RebaS
06-08-2019, 09:43 AM
Hello Paul, Thank you so much. I ran each step and everything was good until Application.ScreenUpdating = True. That deleted blanks in between the names in column A and then the data for each person was off. WHy would I need that line of code? Thank you so much, again!

RebaS
06-08-2019, 09:48 AM
Hello xld,

I had considered that, but I also want to merge the cells for a single person's name and center the text.
Thank you for your reply. I have taken your formula to experiment using it with other data.
Thank you again!

RebaS
06-08-2019, 09:50 AM
Hello Paul,
I appreciate your giving me all of the details. It really helps us newbies!:yes

Paul_Hossler
06-08-2019, 12:05 PM
Hello Paul, Thank you so much. I ran each step and everything was good until Application.ScreenUpdating = True. That deleted blanks in between the names in column A and then the data for each person was off. WHy would I need that line of code? Thank you so much, again!


That line should not do things like that

It didn't in my file in #2

Is your data all in one 'block' or do you have seperator columns?

24365 24366