VBA Error: Cannot use that command on overlapping selections

A

AmeliaBedelia

New Member
Joined
Apr 8, 2018
Messages
19
Hello,
This code was working previously. I added some similar code that links to another document above the place where the error is occurring and now a Run-time error '1004': Cannot use that command on overlapping selections appears in this line of code:

sh3.Range(Left(rowsToDelete, Len(rowsToDelete) - 1)).Delete Shift:=xlUp

sh3 (Comments) has been defined as the sheet I want to delete the row from. I am not sure why it is not working. I have a feeling it might be something simple that I am overlooking...

Appreciate any help.

Here is the entire code (sorry it is long) - this code is for a Retrieve button where the user fills in 4 specified criteria (file #, date it was submitted, work type and issue type) and this code retrieves the information from 3 places: 1. an external excel database(WICount); 2. a MasterRU worksheet within the same workbook, & 3. a Comments worksheet also in the same workbook.

Code: 
Sub RetrievePSOPh1Form()
'This code allows user to retrieve data that was previously entered on the Form worksheet and then transferred to the MasterRU, Comments and WI database

 
Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet
Dim myCriteria As Range, myCriteria1 As Range, myCriteria2 As Range, myCriteria3 As Range
Set sh1 = Sheets("Form")
Set sh2 = Sheets("MasterRU")
Set sh3 = Sheets("Comments")
Dim fn As Range
Dim c As Variant
Dim ws As Worksheet
Dim CheckC As Range
Dim wB As Workbook

With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

'Confirm Manditory fields entered 

 Set CheckC = Range("FileNum")
 If Range("FileNum") = "" Then
 MsgBox "Please enter the file number of the item you wish to retrieve."
 CheckC.Select
 If IsEmpty(CheckC) Then Application.ScreenUpdating = True
    Application.EnableEvents = True
    Exit Sub
 End If
 
 Set CheckC = Range("SubDate")
 If Range("SubDate") = "" Then
 MsgBox "Please enter the Submission Date of the item you wish to retrieve."
 CheckC.Select
 If IsEmpty(CheckC) Then Range("FileNum").Select
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Exit Sub
 End If
 
 Set CheckC = Range("WIType")
 If Range("WIType") = "" Then
 MsgBox "Please enter the Work Item type of the item you wish to retrieve."
 CheckC.Select
 If IsEmpty(CheckC) Then Application.ScreenUpdating = True
    Application.EnableEvents = True
    Exit Sub
 End If
 Set CheckC = Range("Issue")
 If Range("Issue") = "" Then
 MsgBox "Please enter the Issue Type of the item you wish to retrieve."
 CheckC.Select
 If IsEmpty(CheckC) Then Application.ScreenUpdating = True
    Application.EnableEvents = True
    Exit Sub
 End If
 

 
' Set my criteria - what it needs to look for
With Sheets("PSOPh1_Form")
        Set myCriteria = .Range("FileNum")
        Set myCriteria1 = .Range("SubDate")
        Set myCriteria2 = .Range("WIType")
        Set myCriteria3 = .Range("Issue")
  
        Sheets("Form").Unprotect
        Rows("12:107").Hidden = False
        Range("G4").UnMerge
        Range("A111").UnMerge
        Range("A116").UnMerge
        Range("K111").UnMerge
               
    End With

'Look for myCriteria that I set above
lookFor = myCriteria
lookFor1 = myCriteria1
lookFor2 = myCriteria2
lookFor3 = myCriteria3

'Go to WICount database and delete WI.
Set wB = Workbooks.Open("[URL="file://\\DOC-WICount.xlsm"]\\DOC-WICount.xlsm[/URL]")
    'Check if file is open
    If wB.ReadOnly Then
    ActiveWorkbook.Close
    MsgBox "Cannot update as someone is currently updating the database.  Please try again."
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Exit Sub
    End If
        
    wB.Sheets("WICount").Select
    lr = wB.Sheets("WICount").Range("A" & Rows.Count).End(xlUp).row
    blnUpdated = False
    ReDim arr(0)

' Now it looks for the criteria in the columns D, F, H and I
    For i = 1 To lr
     If StrComp(CStr(wB.Sheets("WICount").Range("D" & i).Text), lookFor, vbTextCompare) = 0 And _
        StrComp(CStr(wB.Sheets("WICount").Range("F" & i).Text), lookFor1, vbTextCompare) = 0 And _
        StrComp(CStr(wB.Sheets("WICount").Range("H" & i).Text), lookFor2, vbTextCompare) = 0 And _
        StrComp(CStr(wB.Sheets("WICount").Range("I" & i).Text), lookFor3, vbTextCompare) = 0 Then
        ReDim Preserve arr(UBound(arr) + 1)
        arr(UBound(arr) - 1) = i
     End If
    Next i
    
      
   If UBound(arr) > 0 Then
   
        ReDim Preserve arr(UBound(arr) - 1)
        For i = LBound(arr) To UBound(arr)
            rowsToDelete = rowsToDelete & arr(i) & ":" & arr(i) & ","
        Next I
        wB.Sheets("WICount").Range(Left(rowsToDelete, Len(rowsToDelete) - 1)).Delete Shift:=xlUp
End If
    wB.Save
    wB.Close

    
' Go to MasterRU worksheet and start looking for this data
    Set ws = ThisWorkbook.Sheets("MasterRU")
    lr = ws.Range("A" & Rows.Count).End(xlUp).row
    blnUpdated = False
    ReDim arr(0)

' Now it looks for the criteria in the columns A, C, E and F
    For i = 1 To lr
     If StrComp(CStr(ws.Range("A" & i).Text), lookFor, vbTextCompare) = 0 And _
        StrComp(CStr(ws.Range("C" & i).Text), lookFor1, vbTextCompare) = 0 And _
        StrComp(CStr(ws.Range("E" & i).Text), lookFor2, vbTextCompare) = 0 And _
        StrComp(CStr(ws.Range("F" & i).Text), lookFor3, vbTextCompare) = 0 Then
        ReDim Preserve arr(UBound(arr) + 1)
        arr(UBound(arr) - 1) = i
     End If
    Next i
    
      
   If UBound(arr) > 0 Then
   
' copies the data requested below to sh1
   For c = 2 To 2
   sh2.Cells(arr(UBound(arr) - 1), c).Copy
   sh1.Range("G" & c + 2).PasteSpecial Paste:=xlPasteValues
Next c

'Repeat of same code to now retrieve remaning data
   For c = 11 To 11  'change the numbers to suit
   sh2.Cells(arr(UBound(arr) - 1), c).Copy
   sh1.Range("K" & c - 2).PasteSpecial Paste:=xlPasteValues
Next c
 

   For c = 13 To 21  'change the numbers to suit
   sh2.Cells(arr(UBound(arr) - 1), c).Copy
   sh1.Range("I" & c).PasteSpecial Paste:=xlPasteValues
Next c

   For c = 22 To 34  'change the numbers to suit
   sh2.Cells(arr(UBound(arr) - 1), c).Copy
   sh1.Range("I" & c + 1).PasteSpecial Paste:=xlPasteValues
Next c

   For c = 35 To 47  'change the numbers to suit
   sh2.Cells(arr(UBound(arr) - 1), c).Copy
   sh1.Range("I" & c + 2).PasteSpecial Paste:=xlPasteValues
Next c

   For c = 48 To 54 'change the numbers to suit
   sh2.Cells(arr(UBound(arr) - 1), c).Copy
   sh1.Range("I" & c + 3).PasteSpecial Paste:=xlPasteValues
Next c

   For c = 55 To 63  'change the numbers to suit
   sh2.Cells(arr(UBound(arr) - 1), c).Copy
   sh1.Range("I" & c + 4).PasteSpecial Paste:=xlPasteValues
Next c

   For c = 64 To 86  'change the numbers to suit
   sh2.Cells(arr(UBound(arr) - 1), c).Copy
   sh1.Range("I" & c + 5).PasteSpecial Paste:=xlPasteValues
Next c

   For c = 87 To 101  'change the numbers to suit
   sh2.Cells(arr(UBound(arr) - 1), c).Copy
   sh1.Range("I" & c + 6).PasteSpecial Paste:=xlPasteValues
Next c
 
Application.CutCopyMode = False

End If

  If UBound(arr) > 0 Then
        ReDim Preserve arr(UBound(arr) - 1)
        For i = LBound(arr) To UBound(arr)
            rowsToDelete = rowsToDelete & arr(i) & ":" & arr(i) & ","
        Next i
        Sheets("MasterRU").Select
        ws.Range(Left(rowsToDelete, Len(rowsToDelete) - 1)).Delete Shift:=xlUp
End If
 

' Go to Comments worksheet and start looking for data
   
    lr = sh3.Range("A" & Rows.Count).End(xlUp).row
    blnUpdated = False
    ReDim arr(0)
' Now it looks for the criteria in the columns C, E, G and H
    For i = 1 To lr
     If StrComp(CStr(sh3.Range("C" & i).Text), lookFor, vbTextCompare) = 0 And _
        StrComp(CStr(sh3.Range("E" & i).Text), lookFor1, vbTextCompare) = 0 And _
        StrComp(CStr(sh3.Range("G" & i).Text), lookFor2, vbTextCompare) = 0 And _
        StrComp(CStr(sh3.Range("H" & i).Text), lookFor3, vbTextCompare) = 0 Then
        ReDim Preserve arr(UBound(arr) + 1)
        arr(UBound(arr) - 1) = i
     End If
    Next i
    
      
   If UBound(arr) > 0 Then
 
'Repeat code to copy data from sh3 to sh1

   For c = 13 To 13  'change the numbers to suit
   sh3.Cells(arr(UBound(arr) - 1), c).Copy
   sh1.Range("A" & c + 98).PasteSpecial Paste:=xlPasteValues
Next c

   For c = 14 To 14  'change the numbers to suit
   sh3.Cells(arr(UBound(arr) - 1), c).Copy
   sh1.Range("A" & c + 102).PasteSpecial Paste:=xlPasteValues
Next c

   For c = 12 To 12 'change the numbers to suit
   sh3.Cells(arr(UBound(arr) - 1), c).Copy
   sh1.Range("C" & c + 109).PasteSpecial Paste:=xlPasteValues
Next c

   For c = 11 To 11  'change the numbers to suit
   sh3.Cells(arr(UBound(arr) - 1), c).Copy
   sh1.Range("K" & c + 100).PasteSpecial Paste:=xlPasteValues
Next c
Application.CutCopyMode = False
End If
    
If UBound(arr) > 0 Then
        ReDim Preserve arr(UBound(arr) - 1)
        For i = LBound(arr) To UBound(arr)
            rowsToDelete = rowsToDelete & arr(i) & ":" & arr(i) & ","
        Next i
       Sheets("Comments").Select

' *****This is where the error pops up on this line above*****
      [B]  sh3.Range(Left(rowsToDelete, Len(rowsToDelete) - 1)).Delete Shift:=xlUp[/B]
 

   
'if no match
    Else
        MsgBox "No match. Retrieval has been cancelled."

        
    Sheets("Form").Select
    Application.GoTo Reference:="ClearData"
    Selection.UnMerge
    Selection.ClearContents
    Application.CutCopyMode = False
    Range("G2:J2").Merge
    Range("G4:J4").Merge
    Range("G5:J5").Merge
    Range("G7:J7").Merge
    Range("G8:J8").Merge
    Range("A111:J114").Merge
    Selection.HorizontalAlignment = xlLeft
    Range("A116:J120").Merge
    Selection.HorizontalAlignment = xlLeft
    Range("A123:J126").Merge
    Selection.HorizontalAlignment = xlLeft
    Range("A128:J131").Merge
    Selection.HorizontalAlignment = xlLeft
    Range("K111:N114").Merge
    Selection.HorizontalAlignment = xlLeft
    Application.GoTo Reference:="ClearIO"
    Selection.ClearContents
    Application.CutCopyMode = False
    Application.GoTo Reference:="ClearObs"
    Selection.ClearContents
    Application.CutCopyMode = False
    Application.GoTo Reference:="ClearErr"
    Selection.ClearContents
    Application.CutCopyMode = False
        
    
' Center alignment of the following cells.
    Range("G2").HorizontalAlignment = xlCenter
    Range("G4").HorizontalAlignment = xlCenter
    Range("G5").HorizontalAlignment = xlCenter
    Range("G7").HorizontalAlignment = xlCenter
    Range("G8").HorizontalAlignment = xlCenter
   
' Hide the rows for the checklists
    Rows("12:107").Hidden = True
    Range("G2").Select
    
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    
    Exit Sub
      
End If

blnUpdated = True
MsgBox "Retrieved file successfully."
        
  
    Sheets("Form").Select
    
    
    Range("G4:J4").Select
    Range("G4:J4").Merge
    Range("A111:J114").Select
    Range("A111:J114").Merge
    Range("A116:J120").Select
    Range("A116:J120").Merge
    Range("K111:M114").Select
    Range("K111:M114").Merge
        
    
    Rows("12:107").Hidden = True
    'Sheets("Form").Protect
    Range("FileNum").Select
    Application.CutCopyMode = False
 
    
    
    Application.ScreenUpdating = True
    Application.EnableEvents = True

End Sub


Thank you! :eek:
 
Last edited by a moderator:

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.
Sort by date Sort by votes
It looks like you use this loop in three different places:

Code: 
For i = LBound(arr) To UBound(arr)
    rowsToDelete = rowsToDelete & arr(i) & ":" & arr(i) & ","
Next i

But between iterations, you don't reset rowstoDelete="".

This means that on the second and third iteration, you're probably deleting rows that you didn't mean to.

The error is probably occurring because row numbers have been duplicated, e.g perhaps on the first iteration you mean to delete Range("5:5,10:10,15:15"), and on the second iteration Range("8:8,10:10,12:12").

Therefore your code will try to delete Range("5:5,10:10,15:15,8:8,10:10,12:12") and fail because of the duplicate row 10.
 
Upvote 0
Yes - that was exactly what the problem was. I knew it was probably something very simple.

So just in case someone else ever needs to know the resolution, what I did to reset the rowsToDelete="" was to alter the name of each slightly to be:
rowsToDelete=""
...
rowsToDelete2=""
...
rowsToDelete3=""

This way it was not confusing the previous rowsToDelete with the next 2.

Thanks so much - your help was much appreciated!
 
Upvote 0
You must log in or register to reply here.

Similar threads

L
  • Question
VBA ERROR: Cannot Paste the Selected Copied Content
Replies
7
Views
190
Joe4
Joe4
M
  • Solved
Overflow error
2
Replies
19
Views
498
mysticmario
M
M
  • Question
VBA Code - Run Code if cell value is not blank
Replies
0
Views
431
MHamid
M
N
  • Solved
sometimes problem with vba (Error 400)
Replies
5
Views
152
Domenic
D
E
  • Question
Help Cleaning Up / Optimizing VBA Code
Replies
6
Views
281
offthelip
O

Forum statistics

Threads
1,214,830
Messages
6,121,839
Members
449,051
Latest member
excelquestion515

Share this page

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