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
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.