Autofill error on Excel VBA code - excel

trying to work the VBA autofill function (end of code block) but I am running into an error everytime I try the execute the code. I get "Autofill method of Range class failed". Can someone help me out here? Searched google but nothing works. Probably overlooking something small. Thanks in advance for the help.
Sub UpdateLAB() '---> still need to work on this
'author: css
Dim SalesBook As Workbook
Dim ws2 As Worksheet
Dim wspath As String
Dim n As Integer
Dim FirstRow As Long
Dim LastRow As Long
Dim LastRow2 As Long
Dim sourceCol As Integer
Dim RefCellValue2 As String
Dim ps As String
Dim Platts As Workbook
Application.Calculation = xlCalculationAutomatic
Set SalesBook = Workbooks("ALamb.xlsm")
Set ws2 = SalesBook.Worksheets("US LAB Price")
wspath = "C:\Users\scullycs\Desktop\P&O\Platts Data\Platts 2016.xlsm"
FirstRow = ws2.Range("B4").Row
LastRow = ws2.Range("B4").End(xlDown).Row + 1
LastRow2 = ws2.Range("c4").End(xlDown).Row
sourceCol = 2 'refers to the column your data is in
For n = FirstRow To LastRow
RefCellValue2 = Cells(n, sourceCol).Value
If IsEmpty(RefCellValue2) Or RefCellValue2 = "" Then
Cells(n, sourceCol).Offset(0, -1).Copy
SalesBook.Worksheets("Control Page").Range("C8").PasteSpecial (xlPasteValues)
Else
End If
Next n
ps = SalesBook.Worksheets("Control Page").Range("C9").Text
Set Platts = Workbooks.Open(wspath)
Platts.Worksheets(ps).Activate
Range("A13").End(xlDown).Select
Selection.Offset(0, 11).Select
If Selection.Value = "" Then
MsgBox ("Platts data does not exist")
Platts.Close
Else
Selection.Copy
Set SalesBook = Workbooks("ALamb.xlsm")
SalesBook.Worksheets("US LAB Price").Range("b1").End(xlDown).Offset(1, 0).PasteSpecial (xlPasteValues)
'this is where I get the error
SalesBook.Worksheets("US LAB Price").Range("c4").AutoFill Destination:=Range("C4:C" & LastRow2), Type:=xlFillDefault
Platts.Close
End If
End Sub

Most probably your ranges are not overlapping OR range is too big. In case you want to refer, link.
Check the value of LastRow2.
Make sure the fill range is from same sheet to make them over lapping. To do so break your statement into simple steps. Later you can combine.
Will suggest to break down the statement into
Set SourceRange = SalesBook.Worksheets("US LAB Price").Range("C4:C4")
Set fillRange = SalesBook.Worksheets("US LAB Price").Range("C4:C" & LastRow2)
SourceRange.AutoFill Destination:=fillRange, Type:=xlFillDefault

Related

Copy range of data from sheet 1 Inputs to a sheet 2 inspection log

I have created a spreadsheet with a sheet 1 input table, and want to transfer/copy that data into a sheet 2 log table. The input table on sheet 1 will have an inspection date and an inspection name cells. What I am having an issue with is that I can get the first line of the log to input, but the 2nd line I get a "Run0time error '1004': Application-defined or object defined error". Not sure what to look at from here.
Here's my code (I know, it's stiff rough and needs to be cleaned up):
Private Sub Add_Click()
Dim InspectionDate As String, InspectionName As String
Dim LastRow As Long
Worksheets("sheet1").Select
InspectionDate = Range("B4")
InspectionName = Range("B5")
Worksheets("sheet2").Select
Worksheets("sheet2").Range("B3").Select
If Worksheets("sheet2").Range("B3").Offset(1, 0) <> "" Then
Worksheets("sheet2").Range("B3").End(x1Down).Select
End If
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = InspectionDate
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = InspectionName
Worksheets("sheet1").Select
Worksheets("sheet1").Range("B4:B5").ClearContents
End Sub
Two main reasons why .Select, .Activate, Selection, Activecell, Activesheet, Activeworkbook, etc. should be avoided
The reasons are explained in the second answer on that page.
I have tested the code below and it works for me.
I'm autistic; so sometimes I appear to school others, when I'm only trying to help.
Option Explicit
Private Sub Add_Click()
Dim InspectionDate$, InspectionName$
Dim LastRow&
Dim WS As Worksheet, WS2 As Worksheet
Set WS = Worksheets("sheet1")
Set WS2 = Worksheets("sheet2")
InspectionDate = WS.Range("B4")
InspectionName = WS.Range("B5")
LastRow = 3
If WS2.Range("B" & LastRow + 1) <> "" Then
LastRow = WS2.Range("B" & Rows.count - 1).End(xlUp).Row
End If
WS2.Cells(LastRow + 1, 2) = InspectionDate
WS2.Cells(LastRow + 1, 3) = InspectionName
WS.Range("B4:B5").ClearContents
End Sub

Auto filter method of range class failed

I am trying to write some code to filter and paste data from a table. Problem is I keep getting an "Auto filter method of range class failed with Criteria" error on this line:
wsS1.Cells.AutoFilter Field:=5, Criteria1:=tempCriteria
Can anyone point out what the problem is?
Thanks
Sub FilterBats()
Dim wsS1 As Worksheet
Dim wsS2 As Worksheet
Dim wsS3 As Worksheet
Dim lastrow As Long
Dim lastrow2 As Long
Dim tempCriteria As String
Set wsS1 = Sheets("BallByBallBatting")
Set wsS2 = Sheets("Summary")
Set wsS3 = Sheets("FilteredBats")
Application.ScreenUpdating = False
lastrow2 = wsS3.Range("A" & Rows.Count).End(xlUp).Row
wsS3.Range("A1:N" & lastrow2).Delete
tempCriteria = wsS2.Range("F3").Value
wsS1.Cells.AutoFilter Field:=5, Criteria1:=tempCriteria
lastrow = wsS1.Range("A" & Rows.Count).End(xlUp).Row
'
wsS1.Range("A1:N" & lastrow).Copy wsS3.Range("A1")
wsS1.AutoFilter.ShowAllData
ActiveWorkbook.Sheets("Summary").Activate
Application.ScreenUpdating = True
End Sub
Instead of wsS1.Cells.AutoFilter try allocating a range, not using all the sheet cells...
Something like that: wsS1.Cells(1, 1).AutoFilter should work.
It will certainly work if the column headers are on the first row.

VBA Does not copy the entire row, missing one column

a bit of an odd one. I have a file with large amount of info that goes up to column "CH". Information in the workbook is spread through multiple tabs and when I consolidate data it copies everything except for the last column. Wonder if you could help me with that
Sub consolidation()
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Sheets("Consolidation").Delete
Application.DisplayAlerts = True
With ActiveWorkbook
Set Destination = .Sheets.Add(After:=.Sheets(.Sheets.Count))
Destination.Name = "Consolidation"
End With
Dim i As Integer
Dim stOne As Worksheet
Dim stOneLastRow As Long
Dim stTwo As Worksheet
Dim stTwoLastRow As Long
Dim consolid As Worksheet
Dim consolidLastRow As Long
Set stOne = ThisWorkbook.Sheets("Sheet1")
Set stTwo = ThisWorkbook.Sheets("Sheet2")
Set consolid = ThisWorkbook.Sheets("Consolidation")
stOneLastRow = stOne.Range("C" & Rows.Count).End(xlUp).Row
stTwoLastRow = stTwo.Range("C" & Rows.Count).End(xlUp).Row
consolidLastRow = consolid.Range("C" & Rows.Count).End(xlUp).Row
For i = 6 To stOneLastRow
stOne.Select
If stOne.Range("C6").Value = "OM ID" Then
Cells(i, 3).Resize(1, 100).Copy
consolid.Select
NextRow = Cells(Rows.Count, 2).End(xlUp).Row + 1
Cells(NextRow, 2).Select
ActiveSheet.Paste
stOne.Select
End If
Next i
For i = 7 To stTwoLastRow
stTwo.Select
If stTwo.Range("C6").Value = "OM ID" Then
Cells(i, 3).Resize(1, 100).Copy
consolid.Select
NextRow = Cells(Rows.Count, 2).End(xlUp).Row + 1
Cells(NextRow, 2).Select
ActiveSheet.Paste
stTwo.Select
End If
Next i
End Sub
Initial code is taken from here: https://learn.microsoft.com/en-us/office/vba/api/excel.range.copy
Tried to copy rows based on the value in CH cell, but still copies everything except for that column...
Very weird :-(
Omg... I feel so stupid. The data starts from 3rd column, but I copied everything starting from the 2nd colum... macro works correctly, just needed to change the column...

Copy and paste data from one sheet to multiple where range matches sheet names

I have an API call that pulls data relating to 34 individual sites. Each site has a varying number of assets within it, each with a unique identifier.
I am trying to write a macro that will copy and paste the data for specific sites into their own individual worksheet within the file. The basic concept of this I am familiar with but I am struggling with the ranges I need to specify.
So basically, I need the macro to work its way down Column A of the sheet called Raw Data and identify any rows where the Site name (Value in column A) matches one of the Sheet names. It should then copy the Rows from A to H with that site name and paste into the respective site sheet in rows A to H.
The values in Column A will always match one of the other sheets in the workbook.
Example image that might help explain a bit better:
Apologies in advance if my explanation is not very clear. I have very limited experience using macros so I am not sure if my way of explaining what I want to achieve is understandable or if at all possible.
I am very keen to learn however and any guidance you fine folk could offer would be very much appreciated.
Welcome!
Try this one
Function ChkSheet(SheetName As String) As Boolean
For i = 1 To Worksheets.Count
If Worksheets(i).Name = SheetName Then
ChkSheet = True
Exit Function
End If
Next
ChkSheet = False
End Function
Sub test()
Dim i, j, k As Long
Dim wsRaw As Worksheet
Dim Aux As String
Set wsRaw = Worksheets("Raw Data")
For i = 1 To wsRaw.Range("A:A").SpecialCells(xlCellTypeLastCell).Row
If ChkSheet(wsRaw.Cells(i, 1).Value2) Then
Aux = wsRaw.Cells(i, 1).Value2
k = Worksheets(Aux).Range("A:A").SpecialCells(xlCellTypeLastCell).Row + 1
For j = 1 To 8
Worksheets(Aux).Cells(i + k, j).Value2 = wsRaw.Cells(i, j).Value2
Next
Else
Worksheets.Add.Name = wsRaw.Cells(i, 1).Value2
Aux = wsRaw.Cells(i, 1).Value2
k = 2
For j = 1 To 8
Worksheets(Aux).Cells(i + k, j).Value2 = wsRaw.Cells(i, j).Value2
Next
End If
Next
End Sub
So the Function ChkSheet will check if the sheet exist (you donĀ“t need to create them) and the procedure test will follow all the items that you have in your "Raw Data" worksheet and it will copy to the last used row of every sheet.
And please, even for a newbie, google, read, get some information and when you get stacked, ask for help. This forum is not for giving solutions with not effort.
Good morning all,
David, thanks very much for your help with this. I really didn't want you to think I was trying to get someone to give me the answer and I had tried a few other things before asking the question, but I neglected to show any evidence of my workings. Rookie mistake and I apologise for this.
Having done a bit more research online and with a good dollop of help from a much more experienced colleague I have got the below code using advance filter which works perfectly for what I need.
I thought I would share it here in case it is of any use to others in the future.
Option Explicit
Dim RawDataCol As String
Dim ListCol As String
Dim AdvRng As String
Dim RawDataRng As String
Dim SiteAbrRng As String
Dim ShiftCols As String
Private Sub SetParameters()
'Cell Address where RawData is pasted to each of the site sheets
RawDataCol = "A2"
'Column where the Unique List is cleared and pasted
ListCol = "L"
'Advanced Filter Range
AdvRng = "A1:K2"
'Pasted Raw Data Columns on each sheet
RawDataRng = "A2:K"
'Site Abr gets pasted to the address during loop
SiteAbrRng = "A2"
'Range that gets deleted after pasting Raw Data to each sheet
ShiftCols = "A2:K2"
End Sub
Sub CopyDataToSheets()
On Error GoTo ErrorHandler
AppSettings (True)
Dim StartTime As Double
Dim SecondsElapsed As Double
StartTime = Timer
Dim wbk As Workbook
Dim sht_RawData As Worksheet, sht_target As Worksheet, sht_AdvancedFilter As Worksheet, sht_TurbineData As Worksheet
Dim tbl_RawData As ListObject
Dim LastRow1 As Long, LastRow2 As Long, UniqueListCount As Long
Dim MyArr As Variant
Dim ArrTest As Boolean
Dim x As Long, AdvRowNo As Long
Set wbk = ThisWorkbook
SetParameters
Set sht_RawData = wbk.Worksheets("Raw Data")
Set sht_AdvancedFilter = wbk.Worksheets("Advanced Filter")
Set sht_TurbineData = wbk.Worksheets("Turbine Data")
Set tbl_RawData = sht_RawData.ListObjects("_00")
'clear unqie list of SiteAbr
With sht_TurbineData
LastRow1 = .Cells(Rows.Count, 12).End(xlUp).Row
If LastRow1 > 1 Then
'sht_TurbineData.Range("L1:L" & LastRow1).ClearContents
sht_TurbineData.Range(ListCol & 1 & ":" & ListCol & LastRow1).ClearContents
End If
End With
'Copy Unqiue list of SiteAbr to Turbie Data Sheet
tbl_RawData.Range.Columns(1).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=sht_TurbineData.Range(ListCol & 1), _
Unique:=True
LastRow1 = sht_TurbineData.Cells(Rows.Count, sht_TurbineData.Range(ListCol & 1).Column).End(xlUp).Row
'Sort Unique List
sht_TurbineData.Range("L1:L" & LastRow1).Sort _
Key1:=sht_TurbineData.Range("L1"), _
Order1:=xlAscending, _
Header:=xlYes
'Load unique site Abr to array
With sht_TurbineData
'MyArr = Application.Transpose(.Range("L2:L" & LastRow1))
MyArr = Application.Transpose(.Range(ListCol & 2 & ":" & ListCol & LastRow1))
UniqueListCount = LastRow1 - 1
End With
'Test Array conditions for 0 items or 1 item
ArrTest = IsArray(MyArr)
If UniqueListCount = 1 Then
MyArr = Array(MyArr)
ElseIf UniqueListCount = 0 Then
GoTo ExitSub
End If
For x = LBound(MyArr) To UBound(MyArr)
Set sht_target = wbk.Worksheets(MyArr(x))
With sht_target
'Find the last non blank row of the target paste sheet
LastRow2 = .Cells(Rows.Count, 1).End(xlUp).Row
'Clear contents if the Last Row is not the header row
If LastRow2 > 1 Then
.Range(RawDataRng & LastRow2).ClearContents
End If
sht_AdvancedFilter.Range(SiteAbrRng) = MyArr(x)
'Filter Source Data and Copy to Target Sheet
tbl_RawData.Range.AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=sht_AdvancedFilter.Range(AdvRng), _
CopyToRange:=.Range(RawDataCol), _
Unique:=False
'Remove the first row as this contains the headers
.Range(ShiftCols).Delete xlShiftUp
End With
Next x
ExitSub:
SecondsElapsed = Round(Timer - StartTime, 3)
AppSettings (False)
'Notify user in seconds
MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation
Exit Sub
ErrorHandler:
MsgBox (Err.Number & vbNewLine & Err.Description)
GoTo ExitSub
End Sub
Sub ClearAllSheets()
Dim tbl_SiteList As ListObject
Dim wbk As Workbook
Dim sht_target As Worksheet, sht_TurbineData As Worksheet
Dim MyArray As Variant
Dim x As Long, LastRow As Long
Set wbk = ThisWorkbook
Set sht_TurbineData = wbk.Worksheets("Turbine Data")
Set tbl_SiteList = sht_TurbineData.ListObjects("SiteList")
SetParameters
MyArray = Application.Transpose(tbl_SiteList.DataBodyRange)
For x = LBound(MyArray) To UBound(MyArray)
Set sht_target = wbk.Worksheets(MyArray(x))
LastRow = sht_target.Cells(Rows.Count, 1).End(xlUp).Row
If LastRow > 1 Then
sht_target.Range("A2:K" & LastRow).ClearContents
End If
Next x
End Sub
Private Sub AppSettings(Opt As Boolean)
If Opt = True Then
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
ElseIf Opt = False Then
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End If
End Sub
Thanks again to all who answered and especially to you David. Although I have only used the basic principles from what you offered, it was extremely useful to help me understand what I needed to do in order to get the data to copy into the correct sheets.
Many thanks,
MrChrisP

VBA Runtime Error 1004 on Range.Clear

There are a lot of threads about this error, but I can't get this to work no matter what I try. Most people say it occurs when you try to invoke a method on an inactive sheet, but you shouldn't have to do that. Error is on line 28. Thanks.
Private Sub CommandButton1_Click()
Dim x As Integer
Dim boisePaste As Integer
Dim jrgPaste As Integer
Dim master As Integer
Dim lastRow As Integer
Dim bookCount As Integer
bookCount = Application.Workbooks.Count
For x = 1 To bookCount
If Left(Application.Workbooks(x).Name, 14) = "ITEM_INVENTORY" Then
boisePaste = x
ElseIf Left(Application.Workbooks(x).Name, 6) = "report" Then
jrgPaste = x
ElseIf Left(Application.Workbooks(x).Name, 8) = "Portland" Then
master = x
End If
next x
'Unhide sheets and delete Boise range'
Application.ActiveWorkbook.Sheets("BoisePaste").Visible = True
Sheets("JRGpaste").Visible = True
lastRow = Sheets("BoisePaste").Cells(Rows.Count, "B").End(xlUp).Row
Sheets("BoisePaste").Range(Cells(1,2), Cells(lastRow, 23)).Clear
'Open Boise file and copy range, paste in master'
Application.Workbooks(boisePaste).Activate
With ActiveSheet
.Range(.Cells(1,1), .Cells((.Cells(Rows.Count, "A").End(xlUp).Row),22)).Copy
End With
Application.Workbooks(master).Sheets("BoisePaste").Range(B1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
'Open JRG report and copy range, paste in master'
Application.Workbooks(jrgPaste).Activate
ActiveSheet.Cells.Copy
Application.Workbooks(master).Sheets("JRGpaste").Range(A1).Paste
Application.CutCopyMode = False
'Refresh pivot tables; hide sheets'
Application.Workbooks(master).Activate
With ActiveWorkbook
.RefreshAll
.RefreshAll
.Sheets("BoisePaste").Visible = False
.Sheets("BoisePaste").Visible = False
End With
End Sub
You need to explicitly state which sheet you want the Rows.Count and other such Range uses (Columns,Rows,Cells,etc.) will be on.
Try this:
Sheets("BoisePaste").Range(Sheets("BoisePaste").Cells(1,2), Sheets("BoisePaste").Cells(lastRow, 23)).Clear
So, go through your code and make sure you do this everywhere...i.e. in .Range(.Cells(1,1), .Cells((.Cells(Rows.Count, "A").End(xlUp).Row),22)).Copy, you didn't do it to Rows.Count, so add the sheet there too, to prevent any unexpected actions.
Think of it like this perhaps, with the line
myVariable = Sheets("mySheet").Range(Cells(1,1),Cells(1,2)).Value
VBA is reading that as
In mySheet, look for a range. What range? Hm, the user says Cells(1,1) and Cells(1,2), but what sheet does he want that? The current activesheet is called yourSheet...He specified where the Range should be (sheet called mySheet), but he didn't on Cells(), so I don't know what he wants! mySheet cells(1,1) or yourSheet cells(1,1) ??
(and yes, that's exactly how a computer thinks :P)
Edit: I went through and tried to help tighten up your code. But, as you can see perhaps, I'm not quite positive as to what you want to do, but this should give you some help/insight:
Private Sub CommandButton1_Click()
Dim x As Integer
Dim boisePaste As Integer
Dim jrgPaste As Integer
Dim master As Integer
Dim lastRow As Integer
Dim bookCount As Integer
bookCount = Application.Workbooks.Count
' Create variables to hold the workbook and sheet names.
Dim jrgWS As Worksheet, boiseWS As Worksheet
Dim masterWB As Workbook
Set masterWB = Workbooks(master)
Set jrgWS = Sheets("JRGPaste")
Set boiseWS = Sheets("BoisePaste")
For x = 1 To bookCount
If Left(Application.Workbooks(x).Name, 14) = "ITEM_INVENTORY" Then
boisePaste = x
ElseIf Left(Application.Workbooks(x).Name, 6) = "report" Then
jrgPaste = x
ElseIf Left(Application.Workbooks(x).Name, 8) = "Portland" Then
master = x
End If
Next x
'Unhide sheets and delete Boise range'
Application.ActiveWorkbook.Sheets("BoisePaste").Visible = True
jrgWS.Visible = True
With boiseWS
lastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
.Range(.Cells(1, 2), .Cells(lastRow, 23)).Clear
End With
'Open Boise file and copy range, paste in master'
'' DONT USE ACTIVE SHEET! Use your variables instead
'Application.Workbooks(boisePaste).Activate
With boiseWS
'Since you want values (xlPasteValues), just set the two ranges equal instead of copy/paste
.Range("B1").Value = .Range(.Cells(1, 1), .Cells((.Cells(.Rows.Count, "A").End(xlUp).Row), 22)).Value
End With
'Open JRG report and copy range, paste in master'
' The below just pastes into the same sheet, no??
jrgWS.Cells.Copy
jrgWS.Range("A1").Paste
Application.CutCopyMode = False
'Refresh pivot tables; hide sheets'
Application.Workbooks(master).Activate
With ActiveWorkbook
.RefreshAll
.RefreshAll
.Sheets("BoisePaste").Visible = False
End With
End Sub

Resources