#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 |
|
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 | 07-10-2014 11:09 AM |
How can I avoid doubles? | s7y | Excel | 13 | 05-15-2012 01:17 PM |
Mail Merge Doubles My Document | ExecAssist | Mail Merge | 1 | 02-27-2012 04:06 PM |
How to remove background when copy and paste, no fill doesn't work. | mingo | Word | 1 | 07-29-2010 02:25 PM |
installing copy of XP prof. without product # | vicky | Office | 0 | 04-09-2006 07:16 AM |