The below section of code works majority of the time but occasionally it will throw an error for
loc.PasteSpecial xlValues
with
Runtime 1004' PasteSpecial Method of class failed
I cant get it to regularly fault either so is hampering me tracking down the cause. Error doesn't happen when stepping through the code.
This method of copy and paste special is used a few times through out the macro.
Other answers for this question seem to be different use cases so I'm struggling to find the issue within my code.
'extracts the cfc data out to its own table if its there.
If Not IsError(Application.Match("CFC", rng1, 0)) Then
wb2.Sheets("Import").Activate
'reset filter to show all data
If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then
ActiveSheet.ShowAllData
End If
If ActiveSheet.AutoFilterMode = False Then ActiveSheet.Range("A1:BK1").AutoFilter
ActiveSheet.Range("A1:BK1").AutoFilter Field:=1,
'filters data based on criteria
Criteria1:=Array("*criteria1*"), Operator:=xlFilterValues
ActiveSheet.Range("A1:BK1").AutoFilter Field:=5, Criteria1:=Array("*CFC*"), Operator:=xlFilterValues
'Copys the rows that are visable.
Range("A2:BK" & ActiveSheet.UsedRange.Rows.Count + 1) _
.Cells.SpecialCells(xlCellTypeVisible).Rows.Copy
wb2.Sheets("CFC").Select
'reset filter to show all data
If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then
ActiveSheet.ShowAllData
End If
With Range("a:a") 'find the next available row on sheet data using column A
Set loc = .Find(What:="", LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False)
End With
outputrow = loc.Row 'sets the output row
loc.PasteSpecial xlValues
loc.PasteSpecial xlFormats
End If
Basic fuction is.
Autofilter data based on Criteria on the main data sheet
Copy remaining viable rows
Reset filtering on destination sheet
Find empty row at bottom of table
Paste copied rows to the found location.
I've been trying to sort this for a while now so any help would greatly appreciated.
Only copy the range immediately before you paste it (use a variable to store the range to copy). – Rory
As Rory commented. It was not placing the copy immediately before the paste that was causing the issues.
The copy code was changed to use a sheet reference variable and placed right before the paste and now the macro works as intended 100% of the time. :)
outputrow = loc.Row 'sets the output row
sh1.Range("A2:BK" & sh1.UsedRange.Rows.Count + 1) _
.Cells.SpecialCells(xlCellTypeVisible).Rows.Copy
loc.PasteSpecial xlValues
loc.PasteSpecial xlFormats
Related
What I want:
I've got a lot of sheets whith different devices. Let's call one of these sheets "WS1".
And I've got a seperate sheet with all existing devices and the appropriate OS next to it. This one we call "list".
Now I want the other sheets (e.g. the "WS1") to check the "list", find the right device, and copy the right OS into the WS1-sheet.
the manual way would be:
select cell "C3" of WS1 and copy it.
open the "list"-Sheet and find the copied entry
select the cell left to the found entry and copy it
open the WS1 again, select the left cell right next to the active cell and paste the new clipboard (which contains the OS)
select the next cell which is under and on the right side of the active cell.
loop until every device in WS1 is filled with an OS
What I've got so far:
Dim DataObj As New MSForms.DataObject
Dim strCliBoa As String
'strCliBoa = DataObj.GetText
DataObj.GetFromClipboard
Range("C3").Select
Selection.Copy
strCliBoa = DataObj.GetText
Sheets("list").Select
Range("A1").Select
Cells.Find(What:=strCliBoa, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=False).Activate
ActiveCell.Offset(0, -1).Select
Selection.Copy
strCliBoa = DataObj.GetText
Sheets("WS1").Select
ActiveCell.Offset(0, -1).Select
ActiveSheet.Paste
ActiveCell.Offset(1, 1).Select
My issue:
"Runtime Error 91: Object variable or with block variable not set"
and it marks the cells.find-method.
Can someone tell me what I'm doing wrong?^^
Thanks in advance!
(oh, almost forgot: I'm using ms excel 2010 on Win7)
If the string you're looking for isn't found you'll get that error. The find function returns "Nothing" if nothing is found
Dim r As Range
Set r = Cells.find(What:=strCliBoa, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=False)
If r Is Nothing Then
'handle error
Else
'fill in your code
End If
I'll provide you an answer using the VLOOKUP() function. So Sheet1 contains several devices and I need to find the correct OS. Sheet2 contains the matching between device and OS.
On Sheet1 enter this formula in the cell next to device and pull it down (of course edit to your specific needs).
=VLOOKUP(A2;Sheet2!$A$1:$B$20;2;0)
EDIT: the VLOOKUP function will only work if the OS is in second column. Either switch around the columns or use a helper column at the end to contain the OS.
In the sheet where you have the Device name (WS1) put formula:
=INDEX(List!$A$2:$B$10;MATCH('WS1'!C3;List!$B$2:$B$10;0);1)
Where :
List!$A$2:$B$10 is a range where you have the Devices + OS in the list
'WS1'!C3 is the Device you want to search for in the list ("WS1" in your case)
List!$B$2:$B$10 is the column on Sheet List, where the devices are listed.
Edit 1 - VBA code
If you want to use VBA then use this :
Sub FindDevicePasteOS()
'Find corresponding OS for the device
Dim intRow As Integer
Dim wsht As Worksheet
For Each wsht In Worksheets
If wsht.Name <> "List" Then 'add more sheets you want to exclude using OR (e.g. ... Or wsht.Name <> "Cover Sheet" Then)
For intRow = 3 To wsht.Cells(Rows.Count, 3).End(xlUp).Row 'presuming there is nothing else in the column C below the devices
If Not Worksheets("List").Cells.Find(what:=wsht.Cells(intRow, 3)) Is Nothing Then
wsht.Cells(intRow, 2) = Worksheets("List").Cells.Find(what:=wsht.Cells(intRow, 3)).Offset(0, -1)
End If
Next intRow
End If
Next wsht
End Sub
So I used a psuedo solution where I added the If x is nothing block to the code to skip over the err'd pieces. I was able to process about 80% of the data which is good for me. I still can't understand why Find would return nothing.
Another interesting and maybe related problem occurred in a different computer running the same macro - after I ran into this problem a few times, my computer gave me a blue screen with a 'thread stuck in driver' message. Could they be related? Excel processing to much to fast and get's mixed in the thread processing?
Food for though, I dunno why the find won't just work every-time.
In Sobigen post I had to switch the part LookAt:=xlPart to LookAt:=xlWhole to get it to work because If r Is Nothing Then was throwing an error when it found partial matches. Other than that the code worked great thanks!
I'm having problems, Excel is not updating rows referring to other sheets in same workbook when ordering rows alphabetically.
I have a userform in which there's a button insertCM with this code:
Private Sub insertButton_Click()
ActiveCell.EntireRow.Select
Selection.Insert Shift:=xltoDown
Range("A9:AK9").Copy
Range("A8:AK8").Select
Selection.PasteSpecial Paste:=xlPasteFormulas
Selection.PasteSpecial Paste:=xlPasteFormats
Range("C10").Copy
Range("C8:C9").Select
Selection.PasteSpecial Paste:=xlPasteFormulas
Range("H9:AK9").Copy
Range("H8:AK8").Select
Selection.PasteSpecial Paste:=xlPasteAll
nomCM = Empty
CXinitial = Empty
resteCX = Empty
CCselect = Empty
C4initial = Empty
resteC4 = Empty
compteurCT = Empty
Range("A8").Activate
ActiveCell.RowHeight = 18.6
For i = 2 To ThisWorkbook.Sheets.Count
With Sheets(i).Select
emptyRow = Range("A9").End(xlDown).Offset(0, 2).Row
Range("A9:AL" & emptyRow).Sort _
Key1:=Range("A9"), Order1:=xlAscending
Set SearchRange = Range("A8", Range("A200").End(xlUp))
Set FindRow = SearchRange.Find(nomCM, LookIn:=xlValues, LookAt:=xlWhole)
Range("A" & FindRow.Row).Select
ActiveCell.EntireRow.Activate
End With
Next i
Sheet2.Select
End
End Sub
The userform is used for inserting new clients in several sheets at the same time. Textbox inserts Name, Cost Center, etc., in a blank row and insertButton inserts a new row leaving data inserted in row 8 to go to row 9. After that the code puts all rows alphabetical order so the new client now in row 9 goes to the new one, and cells containing formulas change row numbers.
However some of the sheets have cells containing references to other sheets' cells in the same row. So imagine:
I insert client name "LORUM" "Cost Center 4" and it puts him in row 9 so formula is:
=$C9-COUNTIF($E9:$P9;"CT")+'Sheet5'!$D9
...but when it changes his row to the final one, formula row is:
=$C18-COUNTIF($E18:$P18;"CT")+'Sheet5'!$D9
It does not change row when referring to other sheets.
Any ideas?
It's looks like you've made a good effort, but there are still numerous problems with your code (beside the one line), and I can guarantee that a combination of these issues are preventing your intended outcome.
I can't fix it completely because there are so many bugs that I'm not clear on what you're trying to do, but hopefully this will get you started on the right track...
xlToDown is not a valid reference. You probably mean xlDown
you have a number of undeclared variables and objects, like: i, emptyRow, SearchRange, FindRow, nomCM
you have things (objects?) "set to nothing" that aren't declared or used anywhere: CXinitial, resteCX, CCselect, C4initial, resteC4, compteurCT
your Find statement is looking for nomCM which is empty (and never set), so the Find statement will never find anything.
You should put Option Explicit at the top of every module (especially when learning or troubleshooting). This will prevent issues like the ones above by "forcing" you to properly declare & handle all of your variables, objects, properties, etc.
Near the end, you refer to Sheet2.Select as if Sheet2 is a declared object, instead of using Sheets("Sheet2").Select. I'm not sure why you're selecting the sheet at the very end anyhow.
You have an With..End statement that is doing absolutely nothing since you don't reference it with a . dot anywhere: With Sheets(i).Select .. End With, and also Select isn't used like that.
A mystery End near the end for some reason.
Also, you're unnecessarily doubling up commands like:
ActiveCell.EntireRow.Select
Selection.Insert Shift:=xlDown
..instead of:
ActiveCell.EntireRow.Insert Shift:=xlDown
and another example, all this:
Range("A9:AK9").Copy
Range("A8:AK8").Select
Selection.PasteSpecial Paste:=xlPasteFormulas
Selection.PasteSpecial Paste:=xlPasteFormats
Range("C10").Copy
Range("C8:C9").Select
Selection.PasteSpecial Paste:=xlPasteFormulas
Range("H9:AK9").Copy
Range("H8:AK8").Select
Selection.PasteSpecial Paste:=xlPasteAll
...instead of:
Range("A9:AK9").Copy
Range("A8:AK8").PasteSpecial xlPasteValuesAndNumberFormats
Range("C10").Copy
Range("C8:C9").PasteSpecial Paste:=xlPasteFormulas
Range("H9:AK9").Copy Range("H8:AK8")
All of this would be more clear by Googling the documentation for each command you're unfamiliar with, such as:
Range.Copy Method (Excel)
Range.PasteSpecial Method (Excel)
XlPasteType Enumeration (Excel)
All the ActiveCell and ThisWorkbook references are troublesome but again, I'm not sure what to do with them since I don't know your workbook.
Indentation (and general organization) are very important as well. It may not change the way that the code runs, but it will help you (and others) track down existing & potential issues more easily.
Here is your code cleaned up as best as I could:
Option Explicit 'this line goes at the very top of the module
Private Sub insertButton_Click()
Dim i As Long, emptyRow As Long, SearchRange As Range, FindRow As Range, nomCM
nomCM = Empty
ActiveCell.EntireRow.Insert Shift:=xlDown
Range("A9:AK9").Copy
Range("A8:AK8").PasteSpecial xlPasteValuesAndNumberFormats
Range("C10").Copy
Range("C8:C9").PasteSpecial Paste:=xlPasteFormulas
Range("H9:AK9").Copy Range("H8:AK8")
Range("A8").RowHeight = 18.6
For i = 2 To ThisWorkbook.Sheets.Count
With Sheets(i)
emptyRow = .Range("A9").End(xlDown).Offset(0, 2).Row
.Range("A9:AL" & emptyRow).Sort Key1:=.Range("A9"), Order1:=xlAscending
Set SearchRange = .Range("A8", .Range("A200").End(xlUp))
Set FindRow = SearchRange.Find(nomCM, LookIn:=xlValues, LookAt:=xlWhole)
.Range("A" & FindRow.Row).Select
ActiveCell.EntireRow.Activate
End With
Next i
Sheets("Sheet2").Select
End Sub
as per my test, sorting actually doesn't change other sheet direct references
so you may want to use OFFSET to keep referencing the actual current row index
instead of:
=$C9-COUNTIF($E9:$P9;"CT")+'Sheet5'!$D9
use
=$C9-COUNTIF($E9:$P9;"CT")+ OFFSET('Sheet5'!$D1,ROW()-1,0)
I found a solution:
=INDIRECT(ADDRESS(ROW();4;3;1;"Sheet5"))
Where Row() will always refer to the actual cell's row.
Hope it will help you!
I'm new to VBA and have been playing around with the basics.
What I'm tasked to do is to extract data from a certain row based on the header and column's data. Example, if column under the header "ENG JOBSCOPE" <> "", then extract row of that data.
However, i'm stuck at a point where when the macro loops thru all the worksheets, if the criteria that i want to find using range.find could not find, it'll give me error 91.
I've read up about using normalise but i can't seem to make it work.
Currently i'm using this code
J = 1
For Each ws In x.Worksheets
For Each wks In y.Worksheets
With x.Worksheets(ws.Name)
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
For i=2 to Lastrow
EJOB = Range("A1:DE1").Find(What:="ENG JOBSCOPE", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True, SearchFormat:=False).Column
'Error 91 comes from the above line ^^^
EJobs = ws.Cells(i, EJOB).Value
If EJobs <> "" then
x.Sheets("ID").Rows(i).Copy
y.Sheets("ID").Range("A" & j).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
J=J+1
End if
Next i
Next wks
Next ws
End sub
"ENG JOBSCOPE" is a header. However, some of the worksheet consist of "ENG JOB SCOPE".
Is there another method where i can use to make it so that it'll find the column number regardless of space or capitalization in between?
Also, some of the worksheet doesn't consist of the "ENG JOBSCOPE". Is there a way for the code to continue searching without it stopping with error 91?
I've tried using on error goto next, but the data gets jumbled up.
I hope what i typed is sufficient enough or clear enough. If it isn't clear enough please tell me what is needed to type as i'm new to this forum.
Thank you very much in advance!
use wildcard.
EJOB = Range("A1:DE1").Find(What:="ENG*JOB*SCOPE", LookIn:=xlValues, _
LookAt:=xlWhole, MatchCase:=True, SearchFormat:=False).Column
If you want Find to work regardless of capitalisation, type MatchCase:=False.
I have an Excel VBA macro that I run once a week. I have a piece of code that filters out for different data and then copies the remaining cells to a different worksheet
Here is the portion of effected code:
dim data as worksheet
dim sku vp as worksheet
Set skuvp = Workbooks("weekly Brand snapshot report.xlsx").Sheets("SKU VP")
set data = Workbooks("weekly Brand snapshot report.xlsx").Sheets("SKU Data")
data.Range("A1").AutoFilter Field:=4, Criteria1:="Foods", Operator:=xlFilterValues
data.Range("Onsales[[Product]]").SpecialCells(xlCellTypeVisible).Copy Destination:=skuvp.Range("B2")
skuvp.Range("foods").Sort key1:=skuvp.Range("C1"), order1:=xlDescending, Header:=xlYes
data.ShowAllData
data.Range("A1").AutoFilter Field:=4, Criteria1:="Treats", Operator:=xlFilterValues
data.Range("Onsales[[Product]]").SpecialCells(xlCellTypeVisible).Copy Destination:=skuvp.Range("H2")
skuvp.Range("treats").Sort key1:=skuvp.Range("I1"), order1:=xlDescending, Header:=xlYes
data.ShowAllData
data.Range("A1").AutoFilter Field:=3, Criteria1:="Hardgoods", Operator:=xlFilterValues
data.Range("B2:B16354").SpecialCells(xlCellTypeVisible).Copy Destination:=skuvp.Range("N2")
skuvp.Range("hard").Sort key1:=skuvp.Range("O1"), order1:=xlDescending, Header:=xlYes
data.ShowAllData
data.Range("A1").AutoFilter Field:=3, Criteria1:="Specialty", Operator:=xlFilterValues
data.Range("B2:B16354").SpecialCells(xlCellTypeVisible).Copy Destination:=skuvp.Range("T2")
skuvp.Range("spcl").Sort key1:=skuvp.Range("U1"), order1:=xlDescending, Header:=xlYes
data.ShowAllData
Data and skuvp are set as worksheets.
This code ran fine the very first time I ran it. However, it began having an error after that. The error appears on this line:
data.Range("B2:B16354").SpecialCells(xlCellTypeVisible).Copy Destination:=skuvp.Range("N2")
The error it gives is "Unable to get the Specialcells property of the range class."
I originally had the range in that code set the table column "Onsales[[Product]]" as the range like the previous 2 times I used the code but changed it to a set range to see if that would fix the issue.
Why is this code having an error on that line when the same basic code works a few lines earlier?
I've searched stackoverflow and other online sources for a solution without success.
So, from comments it seems that the problem is solved by using .Cells :
data.Range("B2:B16354").SpecialCells(xlCellTypeVisible).Cells.Copy Destination:=skuvp.Range("N2")
In Excel, I have a Data Validated range using the OFFSET() function that I'm hoping to dynamically add information to that I can then select in a drop down list. I have a VBA macro that I'm adding information to this list from and instead of expanding the list from $L$10:$L$230 to $L$10:$L$231, it shifts my list down to $L$11:$L$230. What am I doing incorrectly in my Named Range or Data Validation to not make this work? Or does it have something with using VBA to add to the range that causes it to work incorrectly?
"Rooms" in my Name Manager Refers To:
=OFFSET(Sheet1!$L$10,0,0,COUNTA(Sheet1!$L:$L),1)
My Data Validation Drop Down Souce:
=Rooms
My "insert" Macro to add to the list:
Sub insert()
'
' insert Macro
'
'
Range("A2:E2").Select
Selection.Copy
Sheets("Sheet1").Select
Range("L10:P10").Select
Selection.insert Shift:=xlDown
Sheets("INSERT NEW ROOM").Select
ActiveWindow.SmallScroll Down:=-18
Range("A2").Select
End Sub
I also have a "Sort" VBA included in my Sheet1 for every time a new instance is added from the "INSERT NEW ROOM" tab.
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Not Intersect(Target, Range("L9:L500")) Is Nothing Then
Range("L9").Sort Key1:=Range("L10"), _
Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End Sub
This happens because your insert macro changes the range your named range formula refers to, just like it would any normal formula.
The formula has a reference to cell $L$10. When you execute
Range("L10:P10").Insert Shift:=xlDown
any formula, including the named range formula, that referes to a cell on or below row 10 will be updated to refer to a cell one row down (ie $L$11 in this case)
You can fix this by changing your named range formula to this
=OFFSET(Sheet1!$L$1,9,0,COUNTA(Sheet1!$L:$L),1)
Notice it now refers to cell $L$1 so is not affected by the insert.
Note:
You insert macro could do with some work
Try this instead
Sub InsertRooms() ' renamed to avoid using a built in function name
Range("A2:E2").Copy
Worksheets("Sheet1").Range("L10:P10").insert Shift:=xlDown
Application.CutCopyMode = False
End Sub