#1




Copy, sort, remove doubles, Cartesian product
Hello,
After running several macros (more than 10) I come up with data like the ones that you see on the attached file. The output data is not the same every time, meaning that I may have 10 records one day, and 100 records on another day. What I want is: A macro or VBA that does all of the following: 1) Copy ALL from column A to a new sheet8 at column H. 2) Sort (ascending) and keep one number if there are doubles (remove doubles if any) at H column. If I have 55 twice, I want only one to be kept. 3) If it is possible I want the doubles to be shown on the next column I because they play significant role later in other macros 4) copy all the data between degrees 0 to 70 to the previous column G 5) Copy the same data beneath on column G but multiplied by minus. If 5 degrees were copied from H column, the G column will have 10 degrees. 5 positive and 5 negative. 6) at H column all the degrees to be copied beneath but multiplied by minus. 7) at A column I want the Cartesian Product of all the data from G and H column. That's all!!!! Any help will be much appreciated !!!! Thank you in advance!!! 
#2




Please post what you already have towards this.

#3




I 've done the first 3.... thank you for help in advance!
Sub Macro3()
' ' Macro3 ' ' Columns("A:A").Select Selection.Copy Sheets("Sheet8").Select Columns("H:H").Select ActiveSheet.Paste Application.CutCopyMode = False ActiveWorkbook.Worksheets("Sheet8").Sort.SortField s.Clear ActiveWorkbook.Worksheets("Sheet8").Sort.SortField s.Add Key:=Range("H1"), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With ActiveWorkbook.Worksheets("Sheet8").Sort .SetRange Range("H2:H500") .Header = xlNo .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With ActiveSheet.Range("$H$1:$H$500").RemoveDuplicates Columns:=1, Header:=xlNo End Sub 
#4




i'm going up to H500 because I wont have more than that in any data file.
I'm going up to H500 because I wont have more than that in a data file.
Quote:

#5




I think this is what you're asking for regarding 4 through 6.
I don't see it as being a layout that would be workable for anything, but I have no idea what a Cartesian Product is. Hope this helps. Code:
' 4) copy all the data between degrees 0 to 70 to the previous column G Dim lastRowH As Long, lastRowG As Long Dim cel As Range, rng As Range With Sheets("Sheet8") lastRowH = .Cells(Rows.Count, "H").End(xlUp).Row For Each cel In .Range("H2:H" & lastRowH) If cel.Value >= 0 And cel.Value <= 70 Then cel.Offset(0, 1).Value = cel.Value End If Next cel ' 5) Copy the same data beneath on column G but multiplied by minus lastRowG = .Cells(Rows.Count, "G").End(xlUp).Row .Range("G2:G" & lastRowG).Copy .Range("G" & lastRowG + 1) For Each cel In .Range("G" & lastRowG + 1 & ":G" & .Cells(Rows.Count, "G").End(xlUp).Row) cel.Value = cel.Value * 1 Next cel ' 6) at H column all the degrees to be copied beneath but multiplied by minus .Range("H2:H" & lastRowH).Copy .Range("H" & lastRowH + 1) For Each cel In .Range("H" & lastRowH + 1 & ":H" & .Cells(Rows.Count, "H").End(xlUp).Row) cel.Value = cel.Value * 1 Next cel End With 
#6




Cartesian Product
The Cartesian Product is the multiplication of all cells in one column with the ones on the other column. Lets suppose that G has the values in cells 50 60 70 80 and H column has the values in cells 2 3 4 .
The cartesian product in A colum that I want is: 50* 2 50* 3 50* 4 60* 2 60* 3 60* 4 70* 2 70* 3 70* 4 80* 2 80* 3 80* 4 Thank you Again!!! 
#7




Just to be more clear
To be more specific I want the outcomes of the calculations:
50* 2=100 50* 3=150 50* 4=200 60* 2=120 60* 3 ... 60* 4 ... 70* 2 70* 3 70* 4 80* 2 80* 3 80* 4 Thank you Again!!! 
#8




Like this ?

#9




No SParks = Great!!!!
Thank you so much my friend!!!! I wanted only the outcomes of the cartesian products at A column but I did some changes to your code and it works fine!!! Thank you Thank you Thank you Thank you Thank you very much for your help!!!

Tags 
cartesian product, copy, sort 
Thread Tools  
Display Modes  

Similar Threads  
Thread  Thread Starter  Forum  Replies  Last Post 
Remove the * from the SubCate, Custom Sort, Replace..Help Please  I need. Thanks  shilabrow  Excel Programming  2  07102014 11:09 AM 
How can I avoid doubles?  s7y  Excel  13  05152012 01:17 PM 
Mail Merge Doubles My Document  ExecAssist  Mail Merge  1  02272012 04:06 PM 
How to remove background when copy and paste, no fill doesn't work.  mingo  Word  1  07292010 02:25 PM 
installing copy of XP prof. without product #  vicky  Office  0  04092006 07:16 AM 