So I essentially want to take a range from one worksheet and remove the duplicates, save that range, without duplicates, as a some object in my vba code. Then paste that range into another sheet. However, I do not want to touch any of the data in Sheet1 when removing the duplicates.
So I have something like:
Sub removeduplicates()
Dim rng As Range
Dim num As Long
With Worksheets("Sheet1")
Set rng = .Range("A2").End(xldown).RemoveDuplicates
num = rng.Row
End With
With Worksheets("Sheet4")
.UsedRange.ClearContents
.
.
.
'Need some code here to essentially paste (w/transpose) in Sheet4 Row 1 columns A to
'to Row 1 column 'num' value. So similar to:
.Range(.Cells(1,1), .Cells(1,num))
Hopefully you understand what I am going for. I probably need to use an array or something instead but I'm just stuck. And this code has probably many mistakes. Its just after a lot of playing around.
Thanks.
copy column A from Sheet1 to Sheet4
remove duplicates from Sheet4 column A
in Sheet4 copy column A to row #1
.
Sub removeduplicates()
Dim rng As Range
Dim s1 As Worksheet, s4 As Worksheet
Set s1 = Sheets("Sheet1")
Set s4 = Sheets("Sheet4")
Dim num As Long
s4.Cells.ClearContents
num = s1.Cells(Rows.Count, 1).End(xlUp).Row
s1.Range("A2:A" & num).Copy s4.Range("A2")
s4.Range("A:A").removeduplicates Columns:=1
num = s4.Cells(Rows.Count, 1).End(xlUp).Row
s4.Range("A1:A" & num).Copy
s4.Range("B1").PasteSpecial Transpose:=True
End Sub
I think Jean-Claude has a good suggestion: copy the entire range, and then do the .RemoveDuplicates on the destination worksheet.
If you must do it in memory, it is possible without even using the .RemoveDuplicates method:
Sub removeduplicates()
Dim r as Range
Dim dictValues as Object
Set dictValues = CreateObject("Scripting.Dictionary")
For each r in Worksheets("Sheet1").Range("A2").End(xldown).Cells
dictValues(r.Value) = r.Value
Next
With dictValues
Worksheets("Sheet4").Range("A1").Resize(1, .Count).Value = .Keys()
End With
NOTE in the event that there are mope than 16,384 unique values in the rng (for Excel 2007+) this will fail.
Related
so recently I have been looking into using defined ranges to copy data instead of selecting, copying and pasting cells. This way I hope to optimise the performance and the runtime of my code.
Unfortunately I have come to face a problem I wasn't able to solve on my own.
When defining a range I want to rearrange the columns in a different order.
For example:
Set my_range = Sheets("Sheet1").Range("A2:E2,G2:H2,J2:K2,M2")
Works well, as the columns I fill into the range are behind each other in the sheet. But now I have this:
Set yo_range = Sheets("Sheet2").Range("D2,AV2,L2,H2,Q2,AE2,AG2")
If I fill these ranges into a new sheet the yo_range will fill the columns I put into it but not in the order I written down. It will put it down in the order according to the original one. In this example yo_range would put the data in this order into the new sheet:
D2 | H2 | L2 | Q2 | AE2 | AG2 | AV2
How can I fix this? I want the order to be another one than the original one.
Also - as you can see my_range has more columns than yo_range. How can I let yo_range be filled into the new sheet but at certain points leave columns out? For example:
my_range(A2:E2) goes into A2:E2 in the new sheet
yo_range(D2,AV2) goes into A:B in the new sheet, then leave C out and then paste yo_range(L2,H2) into D:E in the new sheet
I hope that I was able to explain my problem well and that there is somebody able and willing to help me. Any help is appreciated.
Edit:
Here's the code that puts the values from the ranges into the new sheet
Do
If Application.WorksheetFunction.CountA(my_range) > 0 Then
my_range.Copy ws.Range("A" & ws.Rows.Count).End(xlUp).Offset(1, 0)
Set my_range = my_range.Offset(1, 0)
Else
Exit Do
End If
Loop
Do
If Application.WorksheetFunction.CountA(yo_range) > 0 Then
yo_range.Copy ws.Range("A" & ws.Rows.Count).End(xlUp).Offset(1, 0)
Set yo_range = yo_range.Offset(1, 0)
Else
Exit Do
End If
Loop
We can see that the Copy method will re-arrange the data left-to-right. Try this:
Option Explicit
Public Sub CheckClipboard()
Dim ws As Worksheet
Dim rngToCopy As Range
Dim objData As Object
Dim varContents As Variant
' test data b,c,d,e,f,g in Sheet1!B1:G1
Set ws = ThisWorkbook.Worksheets("Sheet1")
ws.Range("B1:G1").Value = Array("b", "c", "d", "e", "f", "g")
Set rngToCopy = ws.Range("E1:F1,G1,B1:C1") '<-- note not left-to-right order
rngToCopy.Copy '<-- copy
' this is a late bound MSForms.DataObject
Set objData = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
' copy current cell formula to clipboard
objData.GetFromClipboard
varContents = objData.GetText
Debug.Print varContents '<-- re-arranged left-to-right
' cancel copy
Application.CutCopyMode = False
End Sub
I get this in the immediate window:
b c d e f g
So, using Copy is not going to work for what you want to do.
In order to 'paste' the data in the order that you set it in the Range, you need to iterate each Area of the Range and then each cell (i.e. Range) in each Area. See the test code below which replicates your issue and presents a solution:
Option Explicit
Sub MixColumns()
Dim ws As Worksheet
Dim rngIn As Range
Dim rngOut As Range
Dim lng As Long
Dim rngArea As Range
Dim rngCell As Range
Set ws = ThisWorkbook.Worksheets("Sheet1")
' example 1
Set rngIn = ws.Range("B1:C1,E1:F1,G1") '<-- 5 cells, non-contiguous, forward order
Set rngOut = ws.Range("B2:F2") '<-- 5 contiguous cells
rngIn.Copy rngOut '<-- works
' example 2 - OP problem
Set rngIn = ws.Range("E1:F1,G1,B1:C1") '<-- 5 cells, non-contiguous, odd order
Set rngOut = ws.Range("B3:F3") '<-- 5 contiguous cells
rngIn.Copy rngOut '<-- should be e,f,g,b,c but gets b,c,e,f,g
' example 3 - solution for OP problem
Set rngIn = ws.Range("E1:F1,G1,B1:C1") '<-- 5 cells, non-contiguous, odd order
Set rngOut = ws.Range("B4:F4") '<-- 5 contiguous cells
lng = 1 '<-- rngOut cell counter
' iterate areas
For Each rngArea In rngIn.Areas
' iterate cells in area
For Each rngCell In rngArea.Cells
rngOut.Cells(1, lng).Value = rngCell.Value '<-- copy single value
lng = lng + 1 '<-- increment rngOut counter
Next rngCell
Next rngArea '<-- results in e,f,g,b,c
End Sub
Give this output:
My current challenge is that I have a list of data that has been pulled in from another workbook in Columns A-K which all finish on the same row. I want to label the data with all the same value in Column L
The code I have is trying to find the last cell in Column A and the last cell in Column L.
I am then trying to use the range between these two rows to insert a value across the range in Column L:
Sub FillTestType(TestType As String)
Dim rng As Range
Dim wsh As Worksheet
Dim Row As Long
Dim EndCell As Long
Dim TopCell As Long
Set wsh = Worksheets("Sheet1")
wsh.Activate
EndCell = Cells(Rows.count, "A").End(x1Up).Row
TopCell = Cells(Rows.count, "L").End(x1Up).Row
rng = Range(Cells(TopCell, 12), Cells(EndCell, 12)).Value
rng = TestType
End Sub
I keep getting a runtime error - Any help would be greatly appreciated! Or if I am being stupid and there is a better way to tackle the problem please do let me know.
Something like this should work. Mainly collating the comments:
xlUp rather than x1Up (and Option Explicit to catch that yourself in future!)
+1 to TopCell so that you don't overwrite your last value in that row
Fully qualified your Range and Cell references using With and .
Cleaned up variables which aren't necessary -- e.g. for multiple future use or readability
Option Explicit
Sub FillTestType(TestType As String)
Dim EndCell As Long
Dim TopCell As Long
With Worksheets("Sheet1")
EndCell = .Cells(.Rows.Count, "A").End(xlUp).Row
TopCell = .Cells(.Rows.Count, "L").End(xlUp).Row + 1
.Range(.Cells(TopCell, 12), .Cells(EndCell, 12)).Value = TestType
End With
End Sub
I have been using StackOverflow for a while now and just love this community. I know I can get an answer for any problem hopefully.
Ok so here is my issue, I have been performing a "Frankenstein" of a script from several posts on this site. I want to copy and paste a column of an Array Formula beneath specific headers until there are no more headers. For example, in the row F5 through W5, if there is a name, I want to copy the range that has an array formula beneath it, say in the range F156:F323, and paste that formula in the name under the G Column, H Column, so on until there are no more names between that range...
Below is my attempt to solve it but I keep getting errors
Dim lastCol As Long
Dim i As Long
Dim ws As Worksheet
Dim Formula As Range
Set ws = Sheets("Main")
lastCol = ws.Range("F" & Columns.Count).End(xlRight).Column
Set Formula = Sheets("Main").Range("F156:F323")
With ws
For i = 6 To lastCol
If len(trim.range("F" & i).Value)) <> 0 then _
.Range(i & 156).formulaarray = 'my formula here'
Next i
End With
Post any questions you may have and thanks!
You are flipping columns and rows in many instances.
Use the Range Object Cells instead of Range. It allows using column references in numbers instead of letters.
Assign the formula directly.
Dim lastCol As Long
Dim i As Long
Dim ws As Worksheet
Dim Frmla As Range
Set ws = Sheets("Main")
lastCol = ws.Cells(5, ws.Columns.Count).End(xlToLeft).Column
Set Frmla = ws.Range("F156:F323")
With ws
For i = 6 To lastCol
If Len(Trim(.Cells(5, i).Value)) <> 0 Then
.Range(.Cells(156, i), .Cells(323, i)).FormulaR1C1 = Frmla.FormulaR1C1
End If
Next i
End With
I basically need to copy rows from one sheet to another. The rows which I need to copy are on sheet 2 , columns A to N and I need to copy the rows that has the unique value in column N.
Column N will just be =M1 or =M2 depending on which row has data on it.
Hence I will use a worksheet calculate event to try capture this.
The tricky part is that each time new values exist in say the last row on sheet 2 and then N gets filled form M. I don't want the previously copied rows to be copied. It may also be the case that the entire contents of the rows change places or that one of the rows disappears and the other row will fill its gap on sheet 2. So I need to avoid the calculate event recognizing this from the =M line. i.e if it has already been copied but gets recalcuated - -I don't need it to be copied again.
I guess one way to do this would be toi lookup if the N column value exists in the N column value on sheet 1. Because if that row disappears then it will be on the sheet 1. it will because I have other formulas putting it there.
My starting point for dong this is the code below and I have this set in the worksheet code of sheet 1
Private Sub Worksheet_Calculate()
Dim i As Long
Dim lr1 As Long, lr2 As Long
Dim Delta As String
Dim wks1 As Worksheet, wks2 As Worksheet
Set wks1 = ActiveSheet
Set wks2 = Worksheets("Sheet2") 'change to suit
lr1 = wks1.Cells(Rows.Count, "N").End(xlUp).Row
For i = 2 To lr1
lr2 = wks2.Cells(Rows.Count, "A").End(xlUp).Row + 1
wks1.Cells(i, "N").EntireRow.Copy Destination:=wks2.Cells(lr2, "A")
Next i
End Sub
I also have this working which I would need to incorporate into that worksheet calcualte
Sub updt()
Dim sh1 As Worksheet, sh2 As Worksheet, lr As Long, rng As Range
Set sh1 = Sheets(1) 'Edit sheet name
Set sh2 = Sheets(2) 'Edit sheet name
lr = sh1.Cells(Rows.Count, 1).End(xlUp).Row
Set rng = sh1.Range("A2:A" & lr)
For Each c In rng
If WorksheetFunction.CountIf(sh2.Range("A:A"), c.Value) = 0 Then
sh2.Range("A" & sh2.Cells(Rows.Count, 1).End(xlUp).Row)(2) = c.Value
End If
Next
End Sub
The fastest method is pretty sure to copy all wanted rows an then call the remove dublicates function which is almost instantanios. You can simply set your unique col as indicator
The below code gives an error but when I change the range to .Range(A2:A9999) it works...
But it's ugly. Is there way to grab all the data in column(A) from A2 and down? and copy that into B2?
Sheets("AA").Range("A2:A").Value = Sheets("BB").Range("B2:B").Value
To have it in one line you can do it as follows:
Sheets("AA").Range("A2", Cells(Rows.Count, "A")).Copy Sheets("BB").Range("B2")
By the way, it copies everything, not only values but also formatting. To run it your sheet AA should be active one.
Sub CopyValues()
Dim rValues As Range
With Sheet1
Set rValues = .Range("A2", .Cells(.Rows.Count, 1).End(xlUp))
End With
rValues.Offset(, 1).Value = rValues.Value
End Sub
By finding the last populated cell in column A, you can be more precise in what you are copying.
This copies the contents of column A on the src sheet to column B of the tgt sheet:
Sub CopyOneColumnToAnother()
Dim wb As Workbook
Dim src As Worksheet
Dim tgt As Worksheet
Dim lastRow As Long
Set wb = ThisWorkbook
Set src = wb.Sheets("Sheet5")
Set tgt = wb.Sheets("Sheet6")
lastRow = src.Range("A" & src.Rows.Count).End(xlUp).Row
tgt.Range("B2:B" & lastRow).Value = src.Range("A2:A" & lastRow).Value
End Sub
The reason you are getting the error is because your ranges don't have valid end points. Range ([firstcell]:[lastcell]) is the correct syntax, so you need to add a row for the lastcell in both your source and target ranges.
Note that even if your code runs, it won't do want you want. You are setting column A to equal column B. You need to flip the left and right-hand sides of your statement.
Why not just copy the whole column and re-insert whatever was in B1:
Range("A:A").Copy Columns("B:B")
Range("B1").Value = "Whatever"
In more detail:
Dim previous 'As Variant (or whatever it is)
previous = Worksheets("BB").Range("B1").Value
Worksheets("AA").Range("A:A").Copy Worksheets("BB").Columns("B:B")
Worksheets("BB").Range("B1").Value = previous
Unless there is data further down in column B which you wish to keep (you haven't stated).