That command cannot be used on multiple selections vba named range - vba

I get the error "That command cannot be used on multiple selections" when I use a named range in VBA.
VBA is being used to derive a formula which is fine but then I want to just paste the values.
Set rngCopy = rngCopy.Offset(0, 10).SpecialCells(xlCellTypeVisible)
rngCopy.Activate
rngCopy.Value = _
"=IF(RC[-10]="""","""",IF(WEEKDAY(RC[-10])=2,RC[-10]-3,IF(WEEKDAY(RC[-10])<>2,RC[-10]-1)))"
rngCopy.Copy
rngCopy.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False

It works for me. Also if your intention is copy paste the formula as values then you don't need to take that long route. You can simply use Application.Evaluate
Sub Sample()
Dim rngCopy As Range
Set rngCopy = Range("A1")
Set rngCopy = rngCopy.Offset(0, 10).SpecialCells(xlCellTypeVisible)
rngCopy.Value = Application.Evaluate( _
"=IF(RC[-10]="""","""",IF(WEEKDAY(RC[-10])=2,RC[-10]-3,IF(WEEKDAY(RC[-10])<>2,RC[-10]-1)))" _
)
End Sub
Testing with Non Contiguous ranges also works.
Sub Sample()
Dim rngCopy As Range
Set rngCopy = Union(Range("A1"), Range("D1"), Range("F1"))
rngCopy.Activate
rngCopy.Value = Application.Evaluate( _
"=IF(RC[-10]="""","""",IF(WEEKDAY(RC[-10])=2,RC[-10]-3,IF(WEEKDAY(RC[-10])<>2,RC[-10]-1)))" _
)
End Sub

Related

Type Mismatch in PasteSpecial xlPasteValues

I want to copy the contents of two excel in one, and all goes well until I copy the contents of my second excel, because this overwrites what the first copy excel, done that :
These are my statements:
Dim wbOrigen1 As Workbook, _
wbOrigen2 As Workbook, _
wsDestino As Excel.Worksheet, _
wsOrigen1 As Excel.Worksheet, _
wsOrigen2 As Excel.Worksheet, _
rngOrigen1 As Excel.Range, _
rngDestino As Excel.Range, _
rngDestino2 As Excel.Range, _
rngOrigen2 As Excel.Range
Here is the problem
ThisWorkbook.Activate
Set rngDestino2 = wsDestino.Range(celdaDestino,Range(celdaDestino).End(xlDown).Offset(1, 0))
Range(celdaDestino).End(xlDown).Offset(1, 0).Select
wsOrigen2.Activate
rngOrigen2.Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
ThisWorkbook.Activate
rngDestino2.PasteSpecial xlPasteValues
Application.CutCopyMode = False
But this does not work the same way. The problem seems to be with rngDestino2
?rngDestino2
Type Mismatch
?err.Description
Type Mismatch
How I can fix it?
I prefer to avoid select, activate and selection in deference to direct addressing. The paste special, values can also be handled more efficiently by direct cell value transfer.
'make sure that the worksheet vars are set correctly
set wsOrigen2 = <other workbook>.Sheets("Sheet1")
set wsDestino = ThisWorkbook.Sheets("Sheet1")
With wsOrigen2.Cells(1, 1).CurrentRegion
wsDestino.Cells(Rows.Count, 1).End(xlUp) _
.Offset(1, 0).Resize(.Rows.Count, .Columns.Count) = .Cells.Value
End With
set wsDestino = nothing
set wsOrigen2 = nothing
If the workbooks are open and the worksheets are set correctly, that should be all that you really require.
See How to avoid using Select in Excel VBA macros for more methods on getting away from replying on select and activate.

Issues debugging copy paste unique values

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.

Finding row in datasheet and replacing it using VBA excel

I am a total newbie when it comes to visual basic and am looking for some help.
Basically I've already written code that takes a data entry sheet and dumps it into a datasheet in the next available free row.
I am now trying to create a separate page in which users can amend details - to get the details to feed into this page I've just simply used VLookups but now I wish to have a macro that will lookup a particular value in a series of rows and then replace that row with the amended row from the new sheet.
Any help in this would be greatly appreciated as I am massively struggling.
New Information:
I've put this code together to try to demonstrate what I am trying to achieve - I know this code is not very good and won't achieve it but hoping it goes some way to explaining what I'm trying to do.
I'm trying to take "ID" which is located in Sheets("LCH").range("E16"), look for it in Sheets("Data") It will be located in the first column then upon finding the value I want to paste all information in SourceRange to the right of it.
Please see code below:
Sub Button1_Click()
Dim rng1 As Range
Dim ID As Range
Dim DestSheet As Worksheet
Dim SourceRange As Range
Dim DestRange As Range
Set DestSheet = Sheets("Data")
Set ID = Sheets("LCH").Range("E16")
Set SourceRange = Sheets("LCH").range(E17:E90)
Set DestRange = Sheets("Data").Range("A1:ZZZ500")
DestSheet.Activate
Set rng1 = ActiveSheet.Find(ID, Cells(1, ActiveCell.Column), xlFormulas, xlWhole, , xlNext)
SourceRange.Copy
DestRange.PasteSpecial _
Paste:=xlPasteValuesAndNumberFormats, _
operation:=xlPasteSpecialOperationNone, _
skipblanks:=False, _
Transpose:=True
Application.CutCopyMode = False
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
If Not rng1 Is Nothing Then
Application.Goto rng1
Else
MsgBox "10 not found"
End If
End Sub
Sub Tester()
Dim f As Range, IDCell As Range
Set IDCell = Sheets("LCH").Range("E16")
Set f = Sheets("Data").Columns(1).Find(IDCell.Value, _
LookIn:=xlValues, lookat:=xlWhole)
If Not f Is Nothing Then
Sheets("LCH").Range("E17:E90").Copy
f.Offset(0, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, _
Transpose:=True
Application.CutCopyMode = False
Else
MsgBox "ID '" & IDCell.Value & "' not found on data sheet", vbExclamation
End If
End Sub

Issue with For Loop to paste special a row across worksheets

I am trying to copy the last row and paste special at the next row. When I try the following code for an individual worksheet it works fine:
Sub Macro1()
Dim LR As Long
LR = Range("E" & Rows.Count).End(xlUp).Row
Rows(LR).Select
Selection.Copy
Rows(LR + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
But when I am trying to loop through all worksheets, it is only pasting special in one of the worksheets the same copied row number of times instead of repeating to each worksheet. Could you please advise what I am doing wrong on the following for loop?
Sub Macro1()
Dim ws As Worksheet
Dim wb As Workbook
Dim LR As Long
Set wb = ActiveWorkbook
For Each ws In wb.Worksheets
If ws3.Name Like "*.plt" Then
LR = Range("E" & Rows.Count).End(xlUp).Row
Rows(LR).Select
Selection.Copy
Rows(LR + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
Next ws
End Sub
Thanks in advance!
To save some overhead, you should first refrain from using .Select and .Selection.*. If you anyways want to copy just the value you should do so via the .Value property of the cell. Secondly, you should use the With statement to make sure that you are referencing the target sheet. Finally, you should set unused objects to Nothing in the end. The following code should do the trick.
Code
Sub Macro1()
Dim ws As Worksheet
Dim wb As Workbook
Dim rng As Range
Set wb = ActiveWorkbook
For Each ws In wb.Worksheets
With ws
If .Name Like "*.plt" Then
Set rng = .Range("E" & Rows.Count).End(xlUp).EntireRow
rng.Offset(1).Value = rng.Value
End If
End With
Next ws
Set ws = Nothing
Set rng = Nothing
Set wb = Nothing
End Sub
I think that this
If ws3.Name Like "*.plt" Then
might be your issue. You need to enable Option Explicit so that you do not use undefined names.
Also, make
Set wb = ActiveWorkbook
to
Set wb = ThisWorkbook

VBA method 'range of object' _Worksheet failed variables used in range declaration

I am getting the following error message: Method range of object _worksheet failed when trying to select a range in excel using variables as range length.
Below is a snippet of my code:
Private Function copyAmount(startRange As Integer, endRange As Integer)
Dim startRng As String
Dim endRng As String
startRng = "A" & Str(startRange)
endRng = "A" & Str(endRange)
activateBook ("book2.xlsm")
Set rng = Range(startRng, endRng)
Workbooks("book2.xlsm").Sheets(1).Range(rng).Select
Selection.Copy
activateBook ("Book1.xlsm")
Range("D3").Select
Selection.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End Function
Any help would be greatly appreciated.
You are getting the error because you are not fully qualifying your ranges. Also it is not necessary to activate a workbook to do a copy paste :) Also you do not need a Function for this. Use a Sub
CODE
Private Sub copyAmount(startRange As Integer, endRange As Integer)
Dim wbT As Workbook, wbO As Workbook
Dim rng As Range
Set wbT = ThisWorkbook
Set wbO = Workbooks("book2.xlsm")
Set rng = wbO.Sheets(1).Range("A" & startRange & ":" & "A" & endRange)
rng.Copy
'~~> Change Sheets(1) below to the relevant sheet
wbT.Sheets(1).Range("D3").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End Sub
EDIT
Sub, like a Function procedure, is a separate procedure that can take arguments, perform a series of statements, and change the value of its arguments. However a Sub procedure doesn't return a value like a Function does.
Instead of Str, use Cstr. This will make your code work I guess...
You will get this error when your code is in a worksheet and not a module.