Microsoft Office Forums

Go Back   Microsoft Office Forums > Microsoft Excel > Excel Programming

Reply
 
LinkBack Thread Tools Display Modes
  #1  
Old 07-17-2017, 01:10 AM
kleanthis1 kleanthis1 is offline Windows 8 Office 2013
Novice
 
Join Date: Jul 2017
Posts: 6
kleanthis1 is on a distinguished road
Default 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!!!
Attached Images
File Type: jpg AKIS.jpg (143.3 KB, 6 views)
Reply With Quote
  #2  
Old 07-17-2017, 05:56 AM
NoSparks NoSparks is offline Windows 7 64bit Office 2010 64bit
Excel Hobbyist
 
Join Date: Nov 2013
Posts: 330
NoSparks is on a distinguished road
Default

Please post what you already have towards this.
Reply With Quote
  #3  
Old 07-17-2017, 11:52 PM
kleanthis1 kleanthis1 is offline Windows 8 Office 2013
Novice
 
Join Date: Jul 2017
Posts: 6
kleanthis1 is on a distinguished road
Default 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
Reply With Quote
  #4  
Old 07-17-2017, 11:55 PM
kleanthis1 kleanthis1 is offline Windows 8 Office 2013
Novice
 
Join Date: Jul 2017
Posts: 6
kleanthis1 is on a distinguished road
Default 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:
Originally Posted by kleanthis1 View Post
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
Reply With Quote
  #5  
Old 07-18-2017, 06:26 AM
NoSparks NoSparks is offline Windows 7 64bit Office 2010 64bit
Excel Hobbyist
 
Join Date: Nov 2013
Posts: 330
NoSparks is on a distinguished road
Default

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
Reply With Quote
  #6  
Old 07-18-2017, 07:50 AM
kleanthis1 kleanthis1 is offline Windows 8 Office 2013
Novice
 
Join Date: Jul 2017
Posts: 6
kleanthis1 is on a distinguished road
Default 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!!!
Reply With Quote
  #7  
Old 07-18-2017, 07:54 AM
kleanthis1 kleanthis1 is offline Windows 8 Office 2013
Novice
 
Join Date: Jul 2017
Posts: 6
kleanthis1 is on a distinguished road
Default 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!!!
Reply With Quote
  #8  
Old 07-18-2017, 09:27 AM
NoSparks NoSparks is offline Windows 7 64bit Office 2010 64bit
Excel Hobbyist
 
Join Date: Nov 2013
Posts: 330
NoSparks is on a distinguished road
Default

Like this ?
Attached Files
File Type: xlsm KleanThis1.xlsm (23.9 KB, 5 views)
Reply With Quote
  #9  
Old 07-19-2017, 03:49 AM
kleanthis1 kleanthis1 is offline Windows 8 Office 2013
Novice
 
Join Date: Jul 2017
Posts: 6
kleanthis1 is on a distinguished road
Default 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!!!
Reply With Quote
Reply

Tags
cartesian product, copy, sort
Please reply to this thread with any new information or opinions.

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 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


All times are GMT -7. The time now is 01:29 AM.


Powered by vBulletin® Version 3.8.1
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.
SEO by vBSEO ©2011, Crawlability, Inc.
MSOfficeForums.com is not affiliated with Microsoft