More Run-time errors

rjplante

rjplante

Well-known Member
Joined
Oct 31, 2008
Messages
574
Office Version
  1. 365
Platform
  1. Windows
I wish I could figure these out on my own, but I too much a novice for that to happen. Using the code below I get the following error:

------------

Run-time error '1004':

That command cannot be used on multiple selections.

------------

This fails and then highlights the line in red.

What is wrong with the code this time?

Thanks,

Robert


Rich (BB code): 
Sub MSTS_T24_Update()

Application.ScreenUpdating = False

File1 = ActiveWorkbook.Name

ChDir "\\Ferrari\common\Product QC\BioPrep QC\PrepaCyte-CB\PrepaCyte-CB QC\510k Lot Testing\PCB QC Trendline Data"
Workbooks.Open Filename:= _
    "\\Ferrari\common\Product QC\BioPrep QC\PrepaCyte-CB\PrepaCyte-CB QC\510k Lot Testing\PCB QC Trendline Data\Master Stability Tracking Sheet.xlsm"
Range("Z1").ClearContents

Workbooks(File1).Activate

Sheets("QC5003.8 PCB Stab Rec - Storage").Visible = True
Sheets("QC5003.8 PCB Stab Rec - Storage").Range("BE5").Copy

Application.ScreenUpdating = True
Workbooks("Master Stability Tracking Sheet.xlsm").Activate
Application.ScreenUpdating = False
Sheets("Stability").Range("Z1").PasteSpecial Paste:=xlPasteValues

'Loop to find row
Range("A3").Select

Do

If ActiveCell.Value <> Range("Z1").Value Then
Selection.Offset(1, 0).Select
End If

Loop Until ActiveCell.Value = Range("Z1").Value

ActiveCell.Offset(0, 15).Select
ActiveCell.Value = Date

ActiveWorkbook.Save
ActiveWorkbook.Close

Workbooks(File1).Activate

Sheets("QC5003.8 PCB Stab Rec - Storage").Range("BF16").Value = Date

Application.ScreenUpdating = True

Call Intro_page

End Sub
 

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number
Sort by date Sort by votes
I can only guess that it is a merged cell that you are trying to copy over (VBA and Merged Cells go together like oil and water).

Try directly storing the value from one sheet to the other.

Below is some code that should be a bit more optimized. The first stores the value directly, so you don't have to activate and copy/paste to each worksheet. The second optimization searches column A for Z1's value and directly stores the Date in column P.

Code: 
Sub MSTS_T24_Update()

Application.ScreenUpdating = False

File1 = ActiveWorkbook.Name

ChDir "\\Ferrari\common\Product QC\BioPrep QC\PrepaCyte-CB\PrepaCyte-CB QC\510k Lot Testing\PCB QC Trendline Data"
Workbooks.Open Filename:= _
"\\Ferrari\common\Product QC\BioPrep QC\PrepaCyte-CB\PrepaCyte-CB QC\510k Lot Testing\PCB QC Trendline Data\Master Stability Tracking Sheet.xlsm"
Range("Z1").ClearContents

[B][COLOR=Red]Workbooks("Master Stability Tracking Sheet.xlsm").Sheets("Stability").Range("Z1").Value = Workbooks(File1).Sheets("QC5003.8 PCB Stab Rec - Storage").Range("BE5").Value[/COLOR][/B]
'Workbooks(File1).Activate

'Sheets("QC5003.8 PCB Stab Rec - Storage").Visible = True
'Sheets("QC5003.8 PCB Stab Rec - Storage").Range("BE5").Copy

'Application.ScreenUpdating = True
Workbooks("Master Stability Tracking Sheet.xlsm").Activate
Application.ScreenUpdating = False
'Sheets("Stability").Range("Z1").PasteSpecial Paste:=xlPasteValues

'Loop to find row
[COLOR=Red][B]Range("A:A").Find(Range("Z1").Value, LookIn:=xlValues).Offset(0, 15).Value = Date[/B][/COLOR]
'Range("A3").Select

'Do

'If ActiveCell.Value <> Range("Z1").Value Then
    'Selection.Offset(1, 0).Select
'End If

'Loop Until ActiveCell.Value = Range("Z1").Value

'ActiveCell.Offset(0, 15).Select
'ActiveCell.Value = Date

ActiveWorkbook.Save
ActiveWorkbook.Close

Workbooks(File1).Activate

Sheets("QC5003.8 PCB Stab Rec - Storage").Range("BF16").Value = Date

Application.ScreenUpdating = True

Call Intro_page

End Sub
 
Upvote 0
Thanks for the code optimization. I really appreciate the help. I hope someday to actually take a class in VBA so that I can in turn help others with their code issues.

You are awesome!

Robert
 
Upvote 0
Next Run-time error

I have another macro that was working just yesterday and now it is flagging me with the same error.

---
Run-time '1004':

Cannot be used on multiple selections
---

Is there come time continuum that I am violating with my VBA code that it works fine one day and then goes haywire the next?

My code breaks on the first red line below, but I suspect it would also flag the second line in red should I get the first one dealt with.


Thanks for any direction in this matter.

Robert

Rich (BB code): 
Sub MSTS_MAIN_Update()

'   Ask user if they want to update the Master Stability Tracking Sheet.

Application.EnableEvents = False

i = MsgBox("Do you want to update the Master Stability Tracking Sheet?", vbYesNo + vbExclamation + vbDefaultButton2)

If i = 7 Then 'NO
Application.EnableEvents = True
Application.ScreenUpdating = True
Call Intro_page
Exit Sub

ElseIf i = 6 Then 'YES
Application.ScreenUpdating = False

File1 = ActiveWorkbook.Name 'defines the current workbook name as File1

Sheets("QC5003.8 PCB Stab Rec - Storage").Range("BD11:BO11").Copy

'open Master Stability Tracking Sheet workbook

ChDir "\\Ferrari\common\Product QC\BioPrep QC\PrepaCyte-CB\PrepaCyte-CB QC\510k Lot Testing\PCB QC Trendline Data"
Workbooks.Open Filename:= _
    "\\Ferrari\common\Product QC\BioPrep QC\PrepaCyte-CB\PrepaCyte-CB QC\510k Lot Testing\PCB QC Trendline Data\Master Stability Tracking Sheet.xlsm"

'   Check to see if first row is blank and if it is paste data in first row.

If Range("B4").Value = "" Then
Range("B4").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Application.CutCopyMode = False

'   If first row is not blank, go to the first empty row.

Else
Range("B3").End(xlDown).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Application.CutCopyMode = False

End If

'   transfer row number back to the main workbook.

Range("B3").End(xlDown).Offset(0, -1).Copy 'From MSTS trendline workbook

With Workbooks(File1)
    .Sheets("QC5003.8 PCB Stab Rec - Storage").Visible = True
    .Sheets("QC5003.8 PCB Stab Rec - Storage").Range("BE5").PasteSpecial Paste:=xlPasteValues
End With

ActiveWorkbook.Save
ActiveWorkbook.Close    ' close MSTS workbook

Workbooks(File1).Activate

'   record the date MSTS was updated.

Sheets("QC5003.8 PCB Stab Rec - Storage").Range("AH31").Value = Date
Sheets("QC5003.8 PCB Stab Rec - Storage").Visible = False

Application.EnableEvents = True
Application.ScreenUpdating = True

Call Intro_page

MsgBox "Data transfer is complete."

End If

End Sub
 
Upvote 0
Again, try directly storing the value in the cell:

Code: 
Sub MSTS_MAIN_Update()

'   Ask user if they want to update the Master Stability Tracking Sheet.

Application.EnableEvents = False

i = MsgBox("Do you want to update the Master Stability Tracking Sheet?", vbYesNo + vbExclamation + vbDefaultButton2)

If i = 7 Then 'NO
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Call Intro_page
    Exit Sub

ElseIf i = 6 Then 'YES
    Application.ScreenUpdating = False
    
    File1 = ActiveWorkbook.Name 'defines the current workbook name as File1
    
    'Sheets("QC5003.8 PCB Stab Rec - Storage").Range("BD11:BO11").Copy
    
    'open Master Stability Tracking Sheet workbook
    
    ChDir "\\Ferrari\common\Product QC\BioPrep QC\PrepaCyte-CB\PrepaCyte-CB QC\510k Lot Testing\PCB QC Trendline Data"
    Workbooks.Open Filename:= _
        "\\Ferrari\common\Product QC\BioPrep QC\PrepaCyte-CB\PrepaCyte-CB QC\510k Lot Testing\PCB QC Trendline Data\Master Stability Tracking Sheet.xlsm"
    
    '   Check to see if first row is blank and if it is paste data in first row.
    
    If Range("B4").Value = "" Then
       [B][COLOR=Red] Range("B4").Value = Sheets("QC5003.8 PCB Stab Rec - Storage").Range("BD11:BO11").Value[/COLOR][/B]
        
        '   If first row is not blank, go to the first empty row.
        
    Else
        [B][COLOR=Red]Range("B3").End(xlDown).Offset(1, 0).Value = Sheets("QC5003.8 PCB Stab Rec - Storage").Range("BD11:BO11").Value[/COLOR][/B]
        
    End If
    
    '   transfer row number back to the main workbook.
    
    Range("B3").End(xlDown).Offset(0, -1).Copy 'From MSTS trendline workbook
    
    With Workbooks(File1)
        .Sheets("QC5003.8 PCB Stab Rec - Storage").Visible = True
        .Sheets("QC5003.8 PCB Stab Rec - Storage").Range("BE5").PasteSpecial Paste:=xlPasteValues
    End With
    
    ActiveWorkbook.Save
    ActiveWorkbook.Close    ' close MSTS workbook
    
    Workbooks(File1).Activate
    
    '   record the date MSTS was updated.
    
    Sheets("QC5003.8 PCB Stab Rec - Storage").Range("AH31").Value = Date
    Sheets("QC5003.8 PCB Stab Rec - Storage").Visible = False
    
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    
    Call Intro_page
    
    MsgBox "Data transfer is complete."

End If

End Sub
 
Upvote 0
This line generates a subscript out of range error. Is this because we select one cell and attempt to paste in a range of cells?

Range("B4").Value = Sheets("QC5003.8 PCB Stab Rec - Storage").Range("BD11:BO11").Value
 
Upvote 0
Ahh yes, that would cause a problem.

Change that line to:

Code: 
[COLOR=Black]Range("B4:M4").Value = Sheets("QC5003.8 PCB Stab Rec - Storage").Range("BD11:BO11").Value[/COLOR]
 
Upvote 0
Still flags the line with the same subscript out of range error.

and how would I rewrite this line:

Rich (BB code): 
Range("B3").End(xlDown).Offset(1, 0).Value = Sheets("QC5003.8 PCB Stab Rec - Storage").Range("BD11:BO11").Value

Would it look something like this?
Rich (BB code): 
Range("B3").End(xlDown).Offset(1, 0).Range(ActiveCell,Offset(0,12).Value = Sheets("QC5003.8 PCB Stab Rec - Storage").Range("BD11:BO11").Value
 
Last edited:
Upvote 0
rjplante said:
Still flags the line with the same subscript out of range error.

and how would I rewrite this line:

Rich (BB code): 
Range("B3").End(xlDown).Offset(1, 0).Value = Sheets("QC5003.8 PCB Stab Rec - Storage").Range("BD11:BO11").Value
Would it look something like this?
Rich (BB code): 
Range("B3").End(xlDown).Offset(1, 0).Range(ActiveCell,Offset(0,12).Value = Sheets("QC5003.8 PCB Stab Rec - Storage").Range("BD11:BO11").Value
Click to expand...

Perhaps:
Code: 
Range("B3").End(xlDown).Offset(1, 0).Resize(0,12).Value = Sheets("QC5003.8 PCB Stab Rec - Storage").Range("BD11:BO11").Value
 
Upvote 0
Still have that darn subscript out of range issue. Any other thoughts?

BTW Thanks for all the support already.
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Question Question
Run Time Error 462
Replies
3
Views
282
CPO_Rick
C
D
  • Question Question
String running first time but when looping back it isnt placing correctly.
Replies
1
Views
509
DanSMT
D
B
  • Question Question
Run-time error 91 - object variable or with block variable not set
Replies
6
Views
2K
bicke
B
M
  • Question Question
Run time 1004 error on Mac
Replies
2
Views
1K
Matt_O
M
rjplante
  • Question Question
Run Time error
Replies
5
Views
616
pedie
pedie

Forum statistics

Threads
1,224,521
Messages
6,179,282
Members
452,902
Latest member
Knuddeluff

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