VBA "Command cannot be used on multiple selections"

Siyanna

Well-known Member
Joined
Nov 7, 2011
Messages
1,146
Hi Code was working fine but now i am getting this error message ("THAT COMMAND CANNOT BE USED ON MULTIPLE SELECTIONS"

I have BOLDED and underlined where the error highlights

I dont know why this is happening

Code:
Sub ExtractUnproductive()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim ms As Worksheet
Dim ups As Worksheet
Dim prodSh As Worksheet
Dim wfhSh As Worksheet
Dim idxs As Worksheet
Dim Status As String
Set ms = Sheets("RAW DATA")
Set ups = Sheets("UNPRODUCTIVE")
Set prodSh = Sheets("PRODUCTIVE")
Set wfhSh = Sheets("WF HISTORY")
Set idxs = Sheets("INDEX")
Dim LctdR As Long
Dim LunpR As Long
Dim LwfhR As Long
Dim LprodSh As Long
Dim LidxR As Long
ms.Range("N1").Value = "Status" 'Add values to selected cell
ms.Range("O1").Value = "Code"
ms.Range("P1").Value = "Start"
ms.Range("Q1").Value = "Finish"
ms.Range("R1").Value = "Timing"
ms.Range("T1").Value = "Total AQ's"
ms.Range("V1").Value = "Total Mins"
ms.Range("B1").EntireColumn.Insert 'insert column
ms.Range("B1").Value = "User ID"
ms.Range("H1").EntireColumn.Insert 'insert column
ms.Range("H1").Value = "Time"
LctdR = ms.Range("A" & Rows.Count).End(xlUp).Row
LunpR = ups.Range("A" & Rows.Count).End(xlUp).Row
LwfhR = wfhSh.Range("A" & Rows.Count).End(xlUp).Row
LprodSh = prodSh.Range("A" & Rows.Count).End(xlUp).Row
LidxR = idxs.Range("N" & Rows.Count).End(xlUp).Row
With Sheets("RAW DATA")
      
    With .Range("B2:B" & LctdR) 'enter all userId's by using formula
    .Formula = "=Index('INDEX'!$N$4:$N$" & LidxR & ",MATCH('RAW DATA'!C2,'INDEX'!$O$4:$O$" & LidxR & ",0))"
    .Value = .Value
    End With
    
    With .Range("AA2:AA" & LctdR) ' give me the time only
     .Formula = "=Mod(G2,1)"
     .Value = .Value
     .Copy Destination:=.Parent.Range("H2") 'copy to destination range (have to use parent to copy to range H2)
     .Clear 'clear range
    End With
    
    With .Range("H2:H" & LctdR)
        .NumberFormat = "hh:mm:ss" 'format as hh:mm:ss
        .HorizontalAlignment = xlCenter
    End With
    
    With .Range("AB2:AB" & LctdR) ' give me date only
     .Formula = "=INT(G2)"
     .Value = .Value
     .Copy Destination:=.Parent.Range("G2")
     .Clear
    End With
    
    With .Range("G2:G" & LctdR)
        .NumberFormat = "DD/MM/YYYY"
        .HorizontalAlignment = xlCenter
    End With
    With .Range("T2:T" & LctdR) 'find out the timings for each AQ and then paste special values
         .Formula = "=iferror(Vlookup(L2,AQLookup,3,0),"""")"
         .Copy
         .PasteSpecial xlPasteValues
         .Application.CutCopyMode = False
    End With
    
    With .Range("W1") 'enter formula to give the count of visible cells only
         .Formula = "=Subtotal(3, A2:A" & LctdR & ")"
    End With
    With .Range("Y1") 'enter formula to give the sum of visible cells only
         .Formula = "=Subtotal(9, T2:T" & LctdR & ")"
    End With
End With
Dim rngFiltered2 As Range
With Sheets("WORKFLOW")
 .Range("A1:G1").AutoFilter Field:=4, Criteria1:="System Shutdown" 'add filter to sheets workflow range A1:G1
 
 With .AutoFilter.Range 'with the autofilter range
  On Error Resume Next 'if there is an error skip it
   Set rngFiltered2 = .Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible) ' give me the selected cells only excluding the headings
    On Error GoTo 0 'reset back to 0 to find any more errors
    If Not rngFiltered2 Is Nothing Then  'check if anything returned
     rngFiltered2.EntireRow.Delete 'delete all the visible cells
    End If
  End With
  
 .Range("A1:G1").AutoFilter Field:=4 'autofilter to show everything
Dim wfs As Worksheet
Set wfs = Sheets("WORKFLOW")
Dim LwfR As Long
LwfR = wfs.Range("A" & Rows.Count).End(xlUp).Row 'find last row on sheets workflow
   With wfs.Range("M2:M" & LwfR) ' give me the time only
     .Formula = "=If(C2="""","""",Mod(C2,1))"
     .Value = .Value
     .Copy Destination:=.Parent.Range("C2") 'copy to destination range (have to use parent to copy to range C2)
     .Clear 'clear range
   End With
    
   With wfs.Range("C2:C" & LwfR)
    .NumberFormat = "hh:mm:ss"
   End With
    
   With wfs.Range("E2:E" & LwfR)
    .NumberFormat = "hh:mm:ss"
   End With
End With
For c = 2 To LctdR
    For i = 2 To LwfR
        If ms.Cells(c, "B") = wfs.Cells(i, "A") Then 'check to see if agent name could be found
            If wfs.Cells(i, "C").Value > ms.Cells(c, "H").Value Then 'check to see where the completed work is
                If wfs.Cells(i, "D").Value = "Logon" Then 'if its in logon time then fill in the values below
                  ms.Cells(c, "P").Value = "Unproductive"
                  ms.Cells(c, "Q").Value = "Logon"
                  ms.Cells(c, "R").Value = wfs.Cells(i, "C").Value
                  ms.Cells(c, "R").NumberFormat = "hh:mm:ss"
                  ms.Cells(c, "S").Value = wfs.Cells(i + 1, "C").Value
                  ms.Cells(c, "S").NumberFormat = "hh:mm:ss"
                Else
                    Status = wfs.Cells(i - 1, "D").Value 'if any work completed is in a code that is not below then fill in details
                       If Status <> "Yellow Task" And Status <> "Pink Task" And Status <> "Green Task" And Status <> "Purple Task" And Status <> "Other" Then
                          ms.Cells(c, "P").Value = "Unproductive"
                          ms.Cells(c, "Q").Value = Status
                          ms.Cells(c, "R").Value = wfs.Cells(i - 1, "C").Value
                          ms.Cells(c, "R").NumberFormat = "hh:mm:ss" 'format as hh:mm:ss
                          ms.Cells(c, "S").Value = wfs.Cells(i, "C").Value
                          ms.Cells(c, "S").NumberFormat = "hh:mm:ss"
                       End If
                End If
                Exit For
            End If
        End If
    Next i
Next c
Dim rngFiltered As Range
With Sheets("RAW DATA") 'work with sheets raw data
 .Range("A1:T1").AutoFilter Field:=16, Criteria1:="Unproductive" 'autofilter to find the word unproductive
 
 With .AutoFilter.Range
  On Error Resume Next
   Set rngFiltered = .Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    If Not rngFiltered Is Nothing Then  'check if anything returned
     ups.Range("A:B,E:F,I:I,N:N").EntireColumn.Hidden = False 'unhide columns
    [B][U] rngFiltered.EntireRow.Copy 'copy visible cells
     ups.Range("A" & LunpR).Offset(1, 0).PasteSpecial ' paste to unproductive sheet last used row + 1 (blank row)
     rngFiltered.EntireRow.Delete 'delete the unproductive [/U][/B]
    End If
  End With
  
 .Range("A1:T1").AutoFilter Field:=16 'show all data
    
 ' copy to productive sheet
  prodSh.Range("A:A,E:F,N:N,P:S").EntireColumn.Hidden = False
  With .Range("A2:T" & LctdR)
     .Copy 'copy
     prodSh.Range("A" & LprodSh).Offset(1, 0).PasteSpecial
  End With
        
End With
    With Sheets("WORKFLOW")
        With .Range("A2:G" & LwfR)
             .Copy 'copy
             wfhSh.Range("A" & LwfhR).Offset(1, 0).PasteSpecial
        End With
    End With
Application.Calculation = xlCalculationAutomatic 'turn on automatic calculations
Application.ScreenUpdating = True 'turn on screenupdating
End Sub
 
Hi Unfortunately, get the same error

I have been searching google and have found that sometimes when closing excel and refreshing it works Ok. http://www.mrexcel.com/forum/showthread.php?t=396276

Now in my case it did go away a couple of times but then came back with the same error message on the line i have bolded and underlined above.

With this link http://www.mrexcel.com/forum/showthread.php?t=62315

It also states that there have been issues with this and might need to go down an alterntaive route with the copy visble filtered range only which i have no clue how to do this.

Thank you for your help and i hope someone can explain why this happens and has happened all of a sudden even though it worked fine previously and nothing has changed and another code solution to get round this.

Thank YOu ever so much
 
Upvote 0

Excel Facts

What is =ROMAN(40) in Excel?
The Roman numeral for 40 is XL. Bill "MrExcel" Jelen's 40th book was called MrExcel XL.
Have any Excel MVP's Come accross this before ?

Please help me as i cant seem to find a solution anywhere.
 
Upvote 0
Do you have any merged cells in the range you're trying to copy from?
In any event, select the whole filtered (while unfiltered (show all)) range and makes sure there are no merged cells by making sure the check box is empty (no tick or small square box).
Confirm also that the same error occurs with Firefly's .columns(1) suggestion (it's only temporary to debug/test).
Since you're trying to copy entire rows, also check there are no merged cells left and right of the autofilter range.

Otherwise post your sheet (just the source sheet) on the interweb somewhere and link to it here.
 
Upvote 0
Do you have any merged cells in the range you're trying to copy from?
In any event, select the whole filtered (while unfiltered (show all)) range and makes sure there are no merged cells by making sure the check box is empty (no tick or small square box).
Confirm also that the same error occurs with Firefly's .columns(1) suggestion (it's only temporary to debug/test).
Since you're trying to copy entire rows, also check there are no merged cells left and right of the autofilter range.

Otherwise post your sheet (just the source sheet) on the interweb somewhere and link to it here.

Hi,

I have no merged cells. I ran it first thing this morning and it worked.
I closed the file and tried to run it again to see if it works but same thing happens.

How can i post a sample of this sheet?
.
Thank You
 
Upvote 0
To load up a smaple of the file itself you will need to use a file sharing site (such as box.net). Or maybe another alternative might be to use Microsoft's Skydrive and set one of your folders as public and place the file in there.
 
Upvote 0
Hi FireFly,

I have tested the code with

Set rngFiltered = .Resize(.Rows.Count - 1).Offset(1).Columns(1).SpecialCells(xlCellTypeVisible) and it works Ok.

What could have been the problem?
 
Upvote 0
Would i need to do anything different to copy the whole autofiltered range or can i just leave it with .columns(1)?

What appeard to be the problem and how does the columns(1) part pick up the auto filtered range and the original formula all of a sudden stopped picking up the auto filtered range?


Thank You
 
Upvote 0
Hi FireFly,

I have tested the code with

Set rngFiltered = .Resize(.Rows.Count - 1).Offset(1).Columns(1).SpecialCells(xlCellTypeVisible) and it works Ok.

What could have been the problem?

I presume you have hidden columns within your autofilter range?
 
Upvote 0
Have you given up on this?

Hi Sorry,

i thought because it appears to have worked with columns(1), i thought that would be ok.

Would you still need a copy to trouble shoot why it is now working with columns(1) instead of the old method? Its really weird as it was working but this columns(1) method appears to have made it work.
 
Upvote 0

Forum statistics

Threads
1,223,912
Messages
6,175,340
Members
452,638
Latest member
Oluwabukunmi

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top