Solved

Hi! I need some kind of macro for my excel file. I need to sort several columns. Thanks for answer!

Posted on 2003-11-05
15
245 Views
Last Modified: 2010-04-17
I have several columns containing user ID:s. Each column contains different amount of ID:s, an ID can only occurs once in a column. We want to sort the ID:s so that every row contains a certain ID in all the columns. If an ID is not present in a column the row in that column should be empty.

Thanks for all the answers!

//Daniel
0
Comment
Question by:Vamos
  • 7
  • 4
  • 3
  • +1
15 Comments
 
LVL 4

Expert Comment

by:Carl2002
ID: 9686058
Can I see the file?
0
 
LVL 54

Expert Comment

by:Julian Hansen
ID: 9686138
I haven't the time to write a test script but here is the theory.

A quick and dirty mechanism would be to use a catchup process. Do as follows

Macro:

First sort each of the columns by the same criteria (you can do this by doing the sort and recording a macro)
Then
for each row do the following
      Min = lowest ID (lexigographically that Ex. Bob, Bill Zed - Max = Bill)
      for each column
          if cell(row, column) > Min then
            worksheet.Range( ... ).Insert Shift:= down
          end if
      next
next

You can test this manually.

1. Sort all the columns individually
2. Do 1 row at a time - find the lowest value - for every other value in the row that is greater than the lowest, select it and shift the column down.
3. Repeat for each row

When you are finished you will have the desired result.

This may not be the most efficient way but it will work and it should be fairly simple to implement.
0
 
LVL 54

Expert Comment

by:Julian Hansen
ID: 9686154
Opps typo,

I meant (lexigographically that Ex. Bob, Bill Zed - MIN = Bill) Min = Bill not Max!

0
Does Powershell have you tied up in knots?

Managing Active Directory does not always have to be complicated.  If you are spending more time trying instead of doing, then it's time to look at something else. For nearly 20 years, AD admins around the world have used one tool for day-to-day AD management: Hyena. Discover why

 
LVL 24

Expert Comment

by:R_Rajesh
ID: 9689024
Try this,

This code sorts each column and checks if all the cells are equal in each row, if not it deletes that row.

to try this code open a newworkbook paste your data in sheet1, starting at first row, first column. now hit alt+f11 select modules from insert menu this opens the vbe window, paste the code below, close the vbe window. in xl hit alt+f8 select psort click run.

--------------
Sub psort()
For a = 1 To ActiveSheet.UsedRange.Columns.Count
Columns(a).Select
Selection.Sort Key1:=Cells(a, a), Order1:=xlAscending
Next a
'sorting finished
b = 1
Cells(1, 1).Activate
For z = 1 To ActiveSheet.UsedRange.Rows.Count
Cells(b, 1).Select
For a = 1 To ActiveSheet.UsedRange.Columns.Count - 1
If Cells(b, a).Value <> Cells(b, a + 1).Value Then
Cells(b, a).EntireRow.Delete shift:=xlUp
If b > 1 Then b = b - 1
Exit For
End If
Next a
b = b + 1
Next z
End Sub
----------------------
0
 
LVL 54

Expert Comment

by:Julian Hansen
ID: 9692512
R_Rajesh,

I don't think this is what is required. The way I understand it the following should happen

Input

b    c     b
c    d     a
a           x

Output (sorting is not really required based on spec but is required for easiest solution)

a           a
b           b
c     c  
       d
             x

Correct Vamos?
0
 
LVL 54

Accepted Solution

by:
Julian Hansen earned 500 total points
ID: 9692715
This problem intrigued me so I decided to write some code.

Try this out

Sub psort()
    For a = 1 To ActiveSheet.UsedRange.Columns.Count
        Columns(a).Select
        Selection.Sort Key1:=Cells(a, a), Order1:=xlAscending
    Next a

    Cells(1, 1).Activate
    bDone = 0
    nRows = 0
    Row = 0
    While bDone <> 1
    ' Because we are shifting down we have to keep updating the rowcount
        If Row <= nRows Then
            nRows = ActiveSheet.UsedRange.Rows.Count
            Row = Row + 1
            ' Find the min
            Min = "zzzzzzzzzzzzzzzzzzzzzzzzz"
            For Col = 1 To ActiveSheet.UsedRange.Columns.Count
                Cells(Row, Col).Activate
                If Cells(Row, Col) < Min And Not IsEmpty(ActiveCell) Then
                    Min = Cells(Row, Col)
                End If
            Next Col
       
            For Col = 1 To ActiveSheet.UsedRange.Columns.Count
                If Cells(Row, Col) > Min Then
                    Range(Cells(Row, Col), Cells(Row, Col)).Select
                    Range(Cells(Row, Col), Cells(Row, Col)).Insert Shift:=xlDown
                End If
            Next Col
        Else
            bDone = 1
        End If
    Wend
End Sub

Test data used

g    a   r
a    y   e
z    t   w
p    e   p
r         g
e    

Results

a   a
e   e   e
g        g
p        p
r         r
     t
          w
     y
z
0
 
LVL 24

Expert Comment

by:R_Rajesh
ID: 9693352
julianH:
We want to sort the ID:s so that every row contains a certain ID in all the columns.    If an ID is not present in a column the row in that column should
be empty.    <--------- (row in that column)

I could be wrong but what I think  Vamos actually means is that he wants to
retain only those ids that appear in every column and delete the rest i.e. say
there are four columns and that AAA is an ID, so in order to retain AAA it has
to appear in all the four columns. Atleast thats what the code i wrote assumes
but there was a bug in it. it fails if the number of ID's in each columns
are different.

The code below fixes that,

say this is the data in A1:D10

A   B   C   D
1   10  3   8
2   2   2    2
3   3   10  3
4   5   4    4
5   6   5    5
6   7   6    6
7   8   7    7
8   9   8
9   1   9      
10      1      

The result should look something like this

A   B   C   D
8   8   8   8
7   7   7   7
6   6   6   6
5   5   5   5
3   3   3   3
2   2   2   2

----------------
Sub psort()
Dim cl(20)
Sheets(1).Select
lc = Range("IT1").End(xlToLeft).Column
For kk = 1 To lc
For a = 1 To lc
Columns(a).Select
Selection.Sort Key1:=Cells(a, a), Order1:=xlDescending
cl(a) = Sheets(1).Cells(65535, a).End(xlUp).Row
Next a
tt = cl(1)
d = 1
For a = 1 To Range("IT1").End(xlToLeft).Column
If tt > cl(a) Then
tt = cl(a)
d = a
End If
Next a
Dim bFound As Boolean
bFound = False
For a = 1 To lc
For b = 1 To cl(a)
For c = 1 To tt
If Cells(b, a) = Cells(c, d) Then
bFound = True
Exit For
End If
Next c
If bFound = False Then Cells(b, a).ClearContents
bFound = False
Next b
Next a
For a = 1 To lc
Columns(a).Select
Selection.Sort Key1:=Cells(a, a), Order1:=xlDescending
Next a
Next kk
b = 1
Cells(1, 1).Activate
For z = 1 To tt
Cells(b, 1).Select
For a = 1 To lc - 1
If Cells(b, a).Value <> Cells(b, a + 1).Value Then
Cells(b, a).EntireRow.Delete shift:=xlUp
If b > 1 Then b = b - 1
Exit For
End If
Next a
b = b + 1
Next z
End Sub
--------------------------
0
 
LVL 24

Expert Comment

by:R_Rajesh
ID: 9693361
btw if your data is more than 20 columns wide change the array declaration appropriately
0
 

Author Comment

by:Vamos
ID: 9693522
Hi!

say this is the data:
A   B     C    D
bb  ff    gg   ff
ff    bb        gg
gg

I want it to look like this after:

A    B   C    D
bb  bb  
ff    ff         ff
gg       gg   gg

It should not delete something.


0
 
LVL 54

Expert Comment

by:Julian Hansen
ID: 9693550
I'll admit the request may be ambiguous however if you look at the last line of the question
" If an ID is not present in a column the row in that column should be empty"

I interpret this to mean that if an ID is not pressent in a column for a given row then the row remains but the cell is empty. Be that as it may the solutoin I posted above can be easily adapted for this situation (*'s show changed lines)

Sub pssort()
    For a = 1 To ActiveSheet.UsedRange.Columns.Count
        Columns(a).Select
        Selection.Sort Key1:=Cells(a, a), Order1:=xlAscending
    Next a

    Cells(1, 1).Activate
    bDone = 0
    nRows = 1
    Row = 0
*    bDel = False
    While bDone <> 1
    ' Because we are shifting down we have to keep updating the rowcount
        If Row <= nRows Then
            nRows = ActiveSheet.UsedRange.Rows.Count
*            If bDel Then
*                bDel = False
*                Row = Row - 1
*            End If
            Row = Row + 1
            ' Find the min
            Min = "zzzzzzzzzzzzzzzzzzzzzzzzz"
            For Col = 1 To ActiveSheet.UsedRange.Columns.Count
                Cells(Row, Col).Activate
*                If Cells(Row, Col) < Min Then
*                    If IsEmpty(ActiveCell) Then
*                        bDel = True
*                    Else
*                        Min = Cells(Row, Col)
*                    End If
                End If
            Next Col
       
*            If Not bDel Then
                For Col = 1 To ActiveSheet.UsedRange.Columns.Count
                    If Cells(Row, Col) > Min Then
                        Range(Cells(Row, Col), Cells(Row, Col)).Select
                        Range(Cells(Row, Col), Cells(Row, Col)).Insert shift:=xlDown
*                        bDel = True
                    End If
                Next Col
*            End If
*           If bDel Then
*               Cells(Row, 1).EntireRow.Delete shift:=xlUp
*            End If
        Else
            bDone = 1
        End If
    Wend
End Sub
0
 
LVL 54

Expert Comment

by:Julian Hansen
ID: 9693552
Guess that clears that up.

Vamos - my earlier post solves the problem - you can ignore the second code post - it was an adaption to take into account Rajesh's interpretation of the requirement.
0
 

Author Comment

by:Vamos
ID: 9693689
Hi julianH!

Your earlier post should solve my problem. But when I use the code on my data something goes wrong:

This is my data for example:

ABJ       AEG      AED
ABR       AEM      AEG
ACA             
AED             
AEG             
AEM

After it look like this:            

ABJ             
ABR             
ACA             
            AED
AED             
      AEG      AEG
AEG             
      AEM      
AEM             
0
 

Author Comment

by:Vamos
ID: 9693745
sorry

ABJ          
ABR          
ACA          
                     AED
AED          
         AEG     AEG
AEG          
         AEM    
AEM          
0
 
LVL 54

Expert Comment

by:Julian Hansen
ID: 9694155
Vamos,

I have just tried with your data I got the following results

ABJ            
ABR            
ACA            
AED            AED
AEG      AEG      AEG
AEM      AEM      

I can mail you the spreadsheet with the macro and sample data in if you wish.

0
 

Author Comment

by:Vamos
ID: 9694255
julianH,

yes please, my email: trial666@hotmail.com
0

Featured Post

Master Your Team's Linux and Cloud Stack

Come see why top tech companies like Mailchimp and Media Temple use Linux Academy to build their employee training programs.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
STDEVP in SQL 2 68
Device same like our heart 12 85
Basic Java Case or If-Else statement... 3 50
Regular Expression Calculator Tester 2 72
Iteration: Iteration is repetition of a process. A student who goes to school repeats the process of going to school everyday until graduation. We go to grocery store at least once or twice a month to buy products. We repeat this process every mont…
Entering a date in Microsoft Access can be tricky. A typo can cause month and day to be shuffled, entering the day only causes an error, as does entering, say, day 31 in June. This article shows how an inputmask supported by code can help the user a…
Viewers will learn how to properly install Eclipse with the necessary JDK, and will take a look at an introductory Java program. Download Eclipse installation zip file: Extract files from zip file: Download and install JDK 8: Open Eclipse and …
In this fifth video of the Xpdf series, we discuss and demonstrate the PDFdetach utility, which is able to list and, more importantly, extract attachments that are embedded in PDF files. It does this via a command line interface, making it suitable …

770 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question