Remove duplicate, cut and paste columns VBA [SOLVED]

mrzoogle · Aug 7, 2013

Hi Excel Gurus,

Thanks for reading this post in advance. I am stuck in middle of my automation process and needed some help and if you could that would be great!!

What I am trying to achieve is as below:

1.grab comments or line of text from "raw tab".

2.Paste it in the summary tab at the same time delimit the text by "spaces" so that every word is in columns.

3.Then go through each columns and remove duplicate.

4.Then cut and paste all the values in the last cell of the row "A".

So far I have managed to get to step 2 and somewhat to step 3 and basically stuck in step 3 :D

Attached the spreadsheet for your reference as well.

http://www.mediafire.com/?ngm15db4ozcwoy9

[pre]

Code:

Sub Macro3()
&#39;
&#39; Macro3 Macro
&#39;

&#39;
Dim x As Integer
Dim y As Integer

x = 1
y = 29
Do While x &#60;= y

Sheets(&#34;Raw&#34;).Select
Application.DisplayAlerts = False
Columns(&#34;E:E&#34;).Select
Selection.Copy
Sheets(&#34;Split&#34;).Select
Columns(&#34;A:A&#34;).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.TextToColumns Destination:=Range(&#34;A1&#34;), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
), Array(14, 1), Array(15, 1), Array(16, 1)), TrailingMinusNumbers:=True

Sheets(&#34;Split&#34;).Select
ActiveCell.Offset(0, x).Select
Selection.EntireColumn.Select
Application.CutCopyMode = False
ActiveSheet.Range(&#34;$A$1:$A$2060&#34;).RemoveDuplicates Columns:=1, Header:= _
xlYes
x = x + 1
Loop
Application.DisplayAlerts = True

End Sub

[/pre]

Thanks for your time.

Kind Regards,

Zoogle.

Smallman · Aug 8, 2013

Hi Zoogle

You requested a “Guru” and I fall well short of that category, nevertheless I have had a look at your problem and rebuilt it. There is a slight discrepancy between your words to describe what you are doing and your code. The words say nothing about a SPLIT sheet but your code is all over the Split sheet. So this is what I read into your post from the code.

1. Copy the data from the Raw sheet.

2. Paste it in the Split sheet

3. Use text to Columns on the Split Sheet

4. Remove duplicates from all columns on Split sheet.

5. Copy the Split sheet Data into the Summary tab (last used row is my assumption).

If my assumptions are correct then the following will do what you are after.

[pre]

Code:

Option Explicit
Sub Mac1()
Dim i As Integer
Sheet1.Range(&#34;A1&#34;, Range(&#34;A65536&#34;).End(xlUp)).Copy Sheet2.[a1] &#39;Pt 1&2
Sheet2.Columns(1).TextToColumns [a1], 1, , , 1, , , 1, , , Array(1, 1), , , 1 &#39;Pt3
&#39;Rem Duplicates Pt4
For i = 1 To Sheet2.[a1].SpecialCells(11).Column
Sheet2.Columns(i).RemoveDuplicates 1
Next i
Sheet2.[a1].CurrentRegion.Copy Sheet3.Range(&#34;A65536&#34;).End(xlUp)(2) &#39;Pt5
End Sub

[/pre]

Sheet1 is Raw, Sheet2 is Split and Sheet3 is Summary. If you cannot get to work just Paste your Raw Data into Sheet1 of a fresh workbook and it will go like the clappers. Oh one thing I want to check. You do realise when you delete Duplicates that the row is shifted up. This will mean that some lines won’t mean a great deal. Actually thinking about it the whole removing duplicates makes me question the whole process.

Take care

Smallman

mrzoogle · Aug 8, 2013

Hi Smallman,

Thanks for the respond! Really appreciate and apologies for my cdiscrepancy between code.

The attached document have correct wording as I had to amend my sheet to make it clean and forgot to update my pasted code in the previous post.

Your code is awesome! I would like to amend your step 5 assumption though.

Sorry for not being clear, for step 5 what I would like to do is to have all the split values in one column rather than splited across multiple columns with no blanks.

Also will it be possible for you to point me where I can reference how to use these variables and parameters for example "Sheet2.Columns(1).TextToColumns [a1], 1, , , 1, , , 1, , , Array(1, 1), , , 1" I didn't even knew we could do it this way!!

Thanks for your time and looking forward to hear from you soon!

Kind Regards,

Z.

Smallman · Aug 8, 2013

Hi Z

What would be awesome is if you could remember to show your raw data and show what you want the data to look like after the raw data is manipulated. This way there is no confusion : )

Actually could you do that in your next post. Post what the final output should look like, I will deffo be able to replicate.

I thought your request was a strange one. You wanted to delete duplicate data in the columns and that didn't make sense to me.

Righto onto your question. Your code above is recorded and the problem with the Macro Recorder is that it includes everything and lots of additional lines of code which quite often are unnecessary. You can tackle this by looking closely at the code and working out what is important and what is not. Lets start by looking at the Medium version of your code which reduces to this;

Code:

Columns(1).TextToColumns Destination:=Range(&#34;A1&#34;), DataType:=xlDelimited, Space:=True, FieldInfo:=Array(Array(1, 1)), TrailingMinusNumbers:=True


These are the bits you need, ignoring all the parts which say FALSE within your original code.  It is a nice bit of code very well shortened and it has the advantage of being readable. 


However, you can shorten this code further with the following information. Typical Commands usually follow this construct;


Worksheet.Range.ACTION

Dealing between worksheets

or

Range.Action

When you are dealing with just one sheet.  


Lets address each part, so the part which represents your ‘ACTION’ is the TexttoColumns line. You will need to tell vb what you want to the parameters to be from this point.  After you typed TexttoColumns XL helps you with prompts.  The prompts fall into two categories, the parts you want to enter a command for and the parts you don't want to enter anything for.    For the parts you need an action;


[code]Destination:=Range(&#34;A1&#34;)


I simply use;


[code][a1]


as it is means exactly the same thing.  Now it starts to get interesting after [a1] you place a comma and your next question to answer is DataType as XLTextPassingType.  Here you are given two options;


1.XlDelimited

2.XlFixedWidth


Again these can be shortened to 1 and 2 respectively.  So you could use the following options to answer your next question;


DataType:=xlDelimited

or

xlDelimited

or

1


Are you getting the idea yet?  You simply follow this logic all the way through putting comma for False and 1 or the number most appropriate from the list XL provides you with.  So your recorded code below;

[pre]Selection.TextToColumns Destination:=Range(&#34;A1&#34;), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
), Array(14, 1), Array(15, 1), Array(16, 1)), TrailingMinusNumbers:=True

[/pre]

Can ultimately be shortened to this;

Columns(1).TextToColumns [a1], 1, , , 1, , , 1, , , Array(1, 1), , , 1[/code]

You will notice the difference between the above Medium version which I gave you and the shortened line is there are commas in this line and no commas in the Medium version. When you are using this binary method (that is my term) the commas have to be included, where as in longer hand you don't need the commas because you are bypassing the need with statements like this;

TextQualifier:=xlDoubleQuote[/code]

If you use my so called binary method by the end of course no one can read the darn thing but when you know what you are looking for and how the coding is mapped out, it is easy enough to manipulate. It is not everyone's cup of tea but it has the effect of cutting your code back to bare bones and it is a method which I love and use often.

So that is the key to unlocking the above line of code, it does not have to be that cryptic but it helps to know how it is constructed.

Any other questions let the group know, with any luck others can answer with more brevity than I ; )

Take care

Smallman

mrzoogle · Aug 8, 2013

Hi Smallman,

Thanks for explaining this, very helpful. Of course, I will need to go through it few times to get it properly

http://www.mediafire.com/?x7sv784sa9b3a64

I have attached the file so that you can see what the final output should be.

What I am trying to achieve is to see the most popular words.

Kind Regards,

Z.

Smallman · Aug 8, 2013

Hey Mr Z

I just got hit by the sandman and will not get a chance to look at your file till the morning. If your problem is still out there tomoz I will have a look at it for you. Thanks for posting a file, that should make it a slam dunk.

Take it easy

Smallman

SirJB7 · Aug 8, 2013

Hi, mrzoogle!

Give a look at this file:

https://dl.dropboxusercontent.com/u/60558749/Remove%20duplicate%2C%20cut%20and%20paste%20columns%20VBA%20-%20comments%20-%20Copy%20%281%29%20-%20Copy%20%28for%20mrzoogle%20at%20chandoo.org%29.xlsm

If worksheet "split" isn't required for anything else but helper this solution uses only worksheet "summary":

Column A: all words of cells in column A of worksheet "raw"

Column B: unique word list

Column C: count of unique

Column D: rank position

Column E: word

Column F: count

You may just hide columns A:C to get the clean list.

This is the code:

-----

[pre]

Code:

Option Explicit

Sub RankingIsolatedWords()
&#39;
&#39; const
Const ksWSRaw = &#34;raw&#34;
Const ksWSSummary = &#34;summary&#34;
Const kiOuterSpace = 160
Const ksFormulaCount = &#34;=COUNTIF(A:A,B2)&#34;
Const ksFormulaRank = &#34;=ROW()-1&#34;
&#39;
&#39; declarations
Dim rngRaw As Range, rngSummary As Range
Dim lRaw As Long, lSummary As Long, lUnique As Long
Dim vWord As Variant
Dim A As String
&#39;
&#39; start
&#39;  ranges
Set rngRaw = Worksheets(ksWSRaw).Cells
Set rngSummary = Worksheets(ksWSSummary).Cells
&#39;  initialize
With rngSummary
Range(.Rows(2), .Rows(.Rows.Count)).ClearContents
End With
&#39;
&#39; process
&#39;  counters
lRaw = 1
lSummary = 1
&#39;  raw
Do Until rngRaw.Cells(lRaw, 1).Value = &#34;&#34;
&#39; clean up
A = Trim(Replace(rngRaw.Cells(lRaw, 1).Value, Chr(kiOuterSpace), Space(1)))
&#39; load array
vWord = Split(A)
&#39; download array
lSummary = lSummary + 1
With rngSummary
Range(.Cells(lSummary, 1), .Cells(lSummary + UBound(vWord), 1)) = _
Application.WorksheetFunction.Transpose(vWord)
End With
lSummary = lSummary + UBound(vWord)
&#39; cycle
lRaw = lRaw + 1
Loop
&#39;  summary
With rngSummary
&#39; copy
.Columns(1).Copy .Columns(2)
&#39; unique values
.Columns(2).RemoveDuplicates 1
lUnique = .Cells(1, 2).End(xlDown).Row
&#39; formulas
.Cells(2, 3).Formula = ksFormulaCount
.Cells(2, 4).Formula = ksFormulaRank
Range(.Cells(2, 3), .Cells(2, 4)).Copy Range(.Cells(2, 3), .Cells(lUnique, 3))
&#39; copy list
.Columns(&#34;B:C&#34;).Copy
.Columns(&#34;E:F&#34;).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End With
With Worksheets(ksWSSummary)
&#39; sort list
With ActiveSheet.Sort
With .SortFields
.Clear
.Add Key:=Range(&#34;F:F&#34;), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
.Add Key:=Range(&#34;E:E&#34;), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
End With
.SetRange Range(&#34;E:F&#34;)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
.Cells(2, 4).Select
End With
&#39;
&#39; end
Set rngSummary = Nothing
Set rngRaw = Nothing
Beep
&#39;
End Sub

[/pre]
-----

Just advise if any issue.

Regards!

Smallman · Aug 9, 2013

Hey Mr Z

Thanks so much for posting a sample of the results. It helps out no end. With this new info I can alter my above coding to be the following.

I will post a sample workbook when I get home later tonight so you can see the workings. Remember if it doesn’t work on your file, just post Col A of your raw sheet into a test file. Run the code and it will then go well.

[pre]

Code:

Option Explicit
Sub Mac2()
Dim i As Integer
Dim rng As Range
Dim sh As Worksheet
Set sh = Sheet3

Sheet1.Range(&#34;A1&#34;, Sheet1.Range(&#34;A65536&#34;).End(xlUp)).Copy Sheet2.[a1]
Sheet2.Columns(1).TextToColumns [a1], 1, , , 1, , , 1, , , Array(1, 1), , , 1 

For Each rng In Sheet2.UsedRange
Sheet3.Range(&#34;a65536&#34;).End(xlUp)(2) = rng
Next rng

sh.Columns(1).Copy Sheet3.[b1]
sh.Columns(2).RemoveDuplicates 1
sh.Range(&#34;B2&#34;, sh.Range(&#34;B65536&#34;).End(xlUp)).Offset(, 1) = &#34;=countif(A:A,b2)&#34;
sh.Range(&#34;B2&#34;, sh.Range(&#34;C65536&#34;).End(xlUp)).Sort sh.[C2], 2
sh.Range(&#34;A:A,C:C&#34;).Delete 2

End Sub

[/pre]

Take care

Smallman

mrzoogle · Aug 9, 2013

Hi SirJB7 & Smallman,

You guys are stars! Thanks for taking your time in helping me out with this. Really appreciate your efforts and both of these solutions are perfect.

@SirJB7 inclusion of Rank is pretty interesting, never thought of that....

Thanks again and have a very good weekend

Smallman · Aug 9, 2013

Good stuff Mr Z

See you next time : )

Smallman

SirJB7 · Aug 9, 2013

Hi, mrzoogle!

Glad you solved it. Thanks for your feedback and for your kind words too. And welcome back whenever needed or wanted.

Regards!

Smallman · Aug 9, 2013

Hi Z

I promised I would post a link to the workbook, in case anyone is interested in future. It got late last night and the Cricket was on. Have a good weekend.

http://rapidshare.com/files/3642253556/SplitSmallman.xlsm

Take care

Smallman

Remove duplicate, cut and paste columns VBA [SOLVED]

mrzoogle

Member

Smallman

Excel Ninja

mrzoogle

Member

Smallman

Excel Ninja

mrzoogle

Member

Smallman

Excel Ninja

SirJB7

Excel Rōnin

Smallman

Excel Ninja

mrzoogle

Member

Smallman

Excel Ninja

SirJB7

Excel Rōnin

Smallman

Excel Ninja