I am having issues debugging some code I've been working on to copy Unique values from Column AD from Worksheets(1). For the line
aRange.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Worksheets(2).Range("A1"), Unique:=True
I keep getting the debugging error:
The extract range has a missing or illegal field name.
What am I missing?
Sub FilteroOutUniquesSerialNumber()
Dim uniquesArray As Variant
Dim LastRow As Variant
Dim aRange As Range
Set aRange = ActiveWorkbook.Worksheets(1).Columns("AD:AD")
Application.ScreenUpdating = False
With Worksheets(2)
aRange.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Worksheets(2).Range("A1"), Unique:=True
LastRow = ActiveWorkbook.Worksheets(1).Cells(.Rows.Count, "AD").End(xlUp).Row
uniquesArray = ActiveWorkbook.Worksheets(1).Range("AD2:AD" & LastRow)
End With
Dim txt As String, i As Integer
For i = 1 To UBound(uniquesArray)
txt = txt & uniquesArray(i, 1) & ","
Next
Application.ScreenUpdating = True
End Sub
There is always another way to do things. You could always creat another sheet, copy the data you need, and use RemoveDuplicates Excel Formula, which I think is more efficient, you might import this code into yours:
ActiveWorkbook.Worksheets(1).Columns("AD:AD").Copy
ActiveWorkbook.Worksheets(3).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ActiveWorkbook.Worksheets(3).CurrentRegion.RemoveDuplicates Columns:=1, Header:=xlNo
uniquesArray = ActiveWorkbook.Worksheets(3).CurrentRegion
You can always delet content or whole sheet after performing such task.
Related
So I am trying to create a macro that will autofilter a range of data (in Column E) for predefined headers that start at Column N. So the autofilter runs filtering the data in column e for the title in column n, it then copies and pastes that data into column n, then loops and does the same for column o and so on. The issue I am having, is if the filter runs, and there are no matches for the autofilter it creates an error. Strangely, I used if error go to, and for one blank column it works perfectly, however if there are two blank columns as such, then it fails the second time around. I have posted the code below. Does anyone have any suggestions?
Sub Siglum_Sorter()
Sheets("Operator Database").Select
Dim rRng1 As Range
Dim rRng2 As Range
Dim fCol As Long
fCol = 13
Set rRng1 = Range("E:E")
Set rRng2 = Range("G2:G100")
Do
On Error GoTo SkipToHere
fCol = fCol + 1
rCrit = Cells(1, fCol)
MsgBox "cells " & fCol & " " & rCrit
With rRng1
.AutoFilter field:=1, Criteria1:=rCrit, Operator:=xlOr
rRng2.SpecialCells(xlCellTypeVisible).Copy 'or do something else
End With
Cells(2, fCol).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
SkipToHere:
Loop Until IsEmpty(Cells(1, fCol))
End Sub
Dim rngF As Range
With rRng1.AutoFilter field:=1, Criteria1:=rCrit, Operator:=xlOr
Set rngF = Nothing
On Error Resume Next 'ignore any error if no visible cells
Set rngF = rRng2.SpecialCells(xlCellTypeVisible)
On Error Goto 0
If Not rngF Is Nothing Then
'do something with rngF
Else
'no visible cells...
End If
I would just add a a check after the filter to see if the last visible row is the data headers. If so, don't copy the data
Dim lrow_data as long
lrow_data = ThisWorkbook.Sheets("Sheet1").Cells(Cells.Rows.Count,1).End(xlUp) 'or change it to your needed sheet
If lrow_data = 1 Then
'Do Nothing, last row is the headers
Else
rRng2.SpecialCells(xlCellTypeVisible).Copy
End If
The following is my VBA code, for some reason the code will run but not actually paste in the range I need it to paste. Anybody have any ideas why it won't paste my values?
The programs goes to my selected cell that I'm looking for, but now the activecell becomes my range and I'm trying to paste the it there. Any information will help, it just doesn't want to paste the values in the range I selected.
Sub Macro1()
Dim Form1033 As Worksheet
Dim CleaningSchedule As Worksheet
Set Form1033 = Worksheets("Form1033andForm1034")
Set CleaningSchedule = Worksheets("CleaningSchedule")
Dim Day As Range
Set Day = Form1033.Range("$J$3")
With Form1033
Range("$G$5:$G$18").Select
Selection.Copy
End With
With CleaningSchedule
Dim i As Integer
For i = 6 To 37
If Cells(4, i).Value = Day.Value Then
Cells(5, i).Select
Range(ActiveCell, Cells(ActiveCell.Rows + 13, ActiveCell.Column)).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End If
Next i
End With
Form1033.Select
Application.CutCopyMode = False
Range("$G$5:$G$18").ClearContents
MsgBox "Scoresheet Updated"
End Sub
I fixed the code here, but please read the link I provided in my comment, and you will not have these errors in the future.
I also commented the refactors I did to the code. Also, notice that I assigned the Cells and Ranges to the parent worksheet with .. (See #BruceWayne's link in his comment to your original question)
Sub Macro1()
Dim Form1033 As Worksheet
Dim CleaningSchedule As Worksheet
Set Form1033 = Worksheets("Form1033andForm1034")
Set CleaningSchedule = Worksheets("CleaningSchedule")
Dim Day As Range
Set Day = Form1033.Range("$J$3")
'copy the range directly
Form1033.Range("$G$5:$G$18").Copy
With CleaningSchedule
Dim i As Integer
For i = 6 To 37
If .Cells(4, i).Value = Day.Value Then
'paste directly to range and i also combined 13 rows plus row 5, since you are always using the same row
Range(.Cells(5,i), Cells(18,i)).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End If
Next i
End With
'clear contenst directly
Form1033.Range("$G$5:$G$18").ClearContents
MsgBox "Scoresheet Updated"
End Sub
Since you are using "With" statement, you need to add a "." in front of "cells" and "range" and any other references you make. For example:
With myWorksheet
.range("A1").copy
End with
So, the problem in this case is that you still remain on the same worksheet and clear the contents of the cells you had pasted.
I have a code that successfully looks into an external file and copy/pastes the rows that contain that particular condition into the current workbook. For example I am searching for Singapore in the external workbook called Active master project file and copy all the rows containing Singapore to the current workbook that is open.
A problem that occurs is that when I run the same code twice, a border line will exist on the last row of the worksheet. For example when I run the code, it will copy paste the information containing Singapore to the current worksheet called "New Upcoming Projects":
However, when I run the code again it will create a border line on each column such as the image shown below:
And the code that I have for now is:
Sub UpdateNewUpcomingProj()
Dim wb1 As Workbook, wb2 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Dim copyFrom As Range
Dim lRow As Long '<~~ Not Integer. Might give you error in higher versions of excel
Dim strSearch As String
Set wb1 = Application.Workbooks.Open("U:\Active Master Project.xlsm")
Set ws1 = wb1.Worksheets("New Upcoming Projects")
strSearch = "Singapore"
With ws1
'~~> Remove any filters
.AutoFilterMode = False
'~~> I am assuming that the names are in Col A
'~~> if not then change A below to whatever column letter
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
With .Range("A1:A" & lRow)
.AutoFilter Field:=1, Criteria1:="=*" & strSearch & "*"
Set copyFrom = .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow
End With
.AutoFilterMode = False
End With
'~~> Destination File
Set wb2 = ThisWorkbook
Set ws2 = wb2.Worksheets("New Upcoming Projects")
With ws2
If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
lRow = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
Else
lRow = 2
End If
copyFrom.Copy .Rows(lRow)
.Rows.RemoveDuplicates Array(2), xlNo
End With
End Sub
Is there any improvement or additional codes that I have to add in so that the border line would disappear?
As EyePeaSea said you can remove the border by vba code, e.g.
ThisWorkbook.Worksheets("XY").Range("A1", "Z99").Borders.LineStyle = xlNone
In your case the code should be (untested)
copyFrom.Borders.LineStyle = xlNone
after you copied the row
I assume this formatting is coming from the source worksheet. If so, you could PasteSpecial to just paste values, keeping the destination formatting. To do so, simply replace
copyFrom.Copy .Rows(lRow)
with
copyFrom.Copy
.Rows(lRow).PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, False, False
If you do need some formatting from the source sheet, you can use xlPasteAllExceptBorders instead of xlPasteValues.
Paste Special, this will paste to the first empty cell in column A
copyfrom.Copy
ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial xlPasteValues
Application.CutCopyMode = 0
You can add this line after removing the duplicates
.UsedRange.Offset(lRow).Borders.Value = 0
This will remove any borders from the inserted rows
p.s.: I still dont understand where these borders came from, most probably from the original worksheet.. :)
At the end of the code,
please add a new line to format paint of the 3rd row.
So basically before the last two lines
wb1.Select ' please make sure you select the correct one wb1 or wb2 here and try again
Rows("3:3").Select
Selection.Copy
Rows("4:10000").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
end with
end sub 'This is the last line of your code
I have the following VBA code that takes a single row from Sheet "Tabled data", copies the data, then pastes the data into the next available row in Sheet "Running list". However the original row has formulas and I need the values to paste, not the formulas. I've seen numerous ways to do it with Range.PasteSpecial but this code didn't use Range and I'm not sure how to incorporate it.
Note: I modified this code from here: http://msdn.microsoft.com/en-us/library/office/ff837760(v=office.15).aspx. It originally had an IF statement to match content in a cell then paste it in a certain sheet according to the content in the cell. I only had one sheet to copy to and didn't need the IF. I don't really need to find the last row of data to copy either as it will only ever be one row with range of A2:N2. But if I take out the FinalRow section and the For and replace with Range("A2:N2") it doesn't work so I left those in.
Any guidance on how to add in the PasteValues property without making this more complicated? I'm also open to simplification of the For or FinalRow variable such as using Range. I'm only sort of familiar with VBA, having done a few things with it, but usually after much searching and modifying code.
Public Sub CopyData()
Sheets("Tabled data").Select
' Find the last row of data
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
' Loop through each row
For x = 2 To FinalRow
ThisValue = Cells(x, 1).Value
Cells(x, 1).Resize(1, 14).Copy
Sheets("Running list").Select
NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(NextRow, 1).Select
ActiveSheet.Paste
Sheets("Tabled data").Select
Next x
End Sub
Hopefully we can actually make this more simple.
Public Sub CopyRows()
Sheets("Sheet1").UsedRange.Copy
lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
'check if the last cell found is empty
If IsEmpty(ActiveSheet.Cells(lastrow, 1)) = True Then
'if it is empty, then we should fill it
nextrow = lastrow
Else
'if it is not empty, then we should not overwrite it
nextrow = lastrow + 1
End If
ActiveSheet.Cells(nextrow, 1).Select
ActiveSheet.Paste
End Sub
edit: I expanded it a little so that there won't be a blank line at the top
I found a working solution. I recorded a macro to get the paste special in there and added the extra code to find the next empty row:
Sub Save_Results()
' Save_Results Macro
Sheets("Summary").Select 'renamed sheets for clarification, this was 'Tabled data'
'copy the row
Range("Table1[Dataset Name]").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
' paste values into the next empty row
Sheets("Assessment Results").Select
Range("A2").Select
NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(NextRow, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' Return to main sheet
Sheets("Data Assessment Tool").Select
End Sub
Just copy the data all at once, no need to do it a row at a time.
Sub CopyData()
With ThisWorkbook.Sheets("Tabled data")
Dim sourceRange As Range
Set sourceRange = .Range(.Cells(2, 1), .Cells(getLastRow(.Range("A1").Parent), 14))
End With
With ThisWorkbook.Sheets("Running list")
Dim pasteRow As Long
Dim pasteRange As Range
pasteRow = getLastRow(.Range("A1").Parent) + 1
Set pasteRange = .Range(.Cells(pasteRow, 1), .Cells(pasteRow + sourceRange.Rows.Count, 14))
End With
pasteRange.Value = sourceRange.Value
End Sub
Function getLastRow(ws As Worksheet, Optional colNum As Long = 1) As Long
getLastRow = ws.Cells(ws.Rows.Count, colNum).End(xlUp).Row
End Function
Private Sub Load_Click()
Call ImportInfo
End Sub
Sub ImportInfo()
Dim FileName As String
Dim WS1 As Worksheet
Dim WS2 As Worksheet
Dim ActiveListWB As Workbook
Dim check As Integer
'Application.ScreenUpdating = False
Set WS2 = ActiveWorkbook.Sheets("KE_RAW")
confirm = MsgBox("Select (.xlsx) Excel file for Data transfer." & vbNewLine & "Please ensure the sheets are named Sort List, Second and Third.", vbOKCancel)
If confirm = 1 Then
FileName = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls*),*.xls*", _
Title:="Select Active List to Import", MultiSelect:=False)
If FileName = "False" Then
MsgBox "Import procedure was canceled"
Exit Sub
Else
Call CleanRaw
Set ActiveListWB = Workbooks.Open(FileName)
End If
Set WS1 = ActiveListWB.Sheets("Sort List")
WS1.UsedRange.Copy 'WS2.Range("A1")
' WS2.Range("A1").Select
WS2.UsedRange.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'WS2.Range ("A1")
ActiveWorkbook.Close False
'Call ClearFormulas
' Call RefreshAllPivotTables
Sheets("Key Entry Data").Select
'Sheets("Raw").Visible = False
'Application.ScreenUpdating = True
MsgBox "Data has been imported to workbook"
Else
MsgBox "Import procedure was canceled"
End If
Application.ScreenUpdating = True
End Sub
Sub CleanRaw()
Sheets("KE_RAW").Visible = True
Sheets("KE_RAW").Activate
ActiveSheet.Cells.Select
Selection.ClearContents
End Sub
i am trying to use pastespecial in vba..i basically need to paste the values (and not the formulas as the formula gets recalculated while pasting to the new sheet because of change in the cell values in that sheet) to another sheet...But i am getting error 1004 saying 'aaplication defined or object defined error'..heres the code...please help somebdy...
Sub Macro1try()
Dim i As Integer
Dim j As Integer
For i = 1 To 2
Worksheets("Volatility").Cells(1, "B").Value = Worksheets("Volatility").Cells(i, "S").Value
Call mdlMain.ExtractData
Range("A11:D2330").Select
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
ActiveWorkbook.Sheets("Volatility").Activate
Next i
End Sub
This I learned the hard way: Avoid Copy/Paste if at all possible! Copy and Paste use the clipboard. Other programs may read from / write to the clipboard while your code is running, which will cause wild, unpredictable results at both ends.
In your particular case, Copy and Paste are completely unnecessary. Just use =.
For i = 1 To 2
'// Your stuff, which I won't touch:
Worksheets("Volatility").Cells(1, "B").Value _
= Worksheets("Volatility").Cells(i, "S").Value
Call mdlMain.ExtractData
Sheets.Add After:=Sheets(Sheets.Count)
'// The following single statement replaces everything else:
Sheets(Sheets.Count).Range("A11:D2330").Value _
= Sheets("Volatility").Range("A11:D2330").Value
'// Voilà. No copy, no paste, no trouble.
'// If you need the number format as well, then:
Sheets(Sheets.Count).Range("A11:D2330").NumberFormat_
= Sheets("Volatility").Range("A11:D2330").NumberFormat
Next i
You need to state where you're putting it on the sheet
Sub Macro1try()
Dim i As Integer
Dim j As Integer
For i = 1 To 2
Worksheets("Volatility").Cells(1, "B").Value = Worksheets("Volatility").Cells(i, "S").Value
Call mdlMain.ExtractData
Sheets.Add After:=Sheets(Sheets.Count)
Worksheets("Volatility").Range("A11:D2330").Copy
Sheets(Sheets.Count).Range("A11:D2330").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Next i
End Sub
Add
".Range("A1")."
Between 'ActiveSheet' and 'PasteSpecial'
Change A1 to the location you want to paste to.