I'm having an issue with my code to autofill some using VBA in Excel. I keep getting the error "AutoFill method of range class failed" but I'm not sure what is wrong with the code. it looks okay to me but maybe I'm missing something? The code is as follows:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, _
Cancel As Boolean)
A = MsgBox("Do you really want to save the workbook?", vbYesNo)
If A = vbNo Then Cancel = True
Dim lrow As Long
lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Range("A1").Select
Selection.AutoFill Destination:=Range("A1:A" & lastrow)
Range("A1:A" & lastrow).Select
'Range("D1").Select
'Selection.AutoFill Destination:=Range("D1:D" & lastrow)
'Range("D1:D" & lastrow).Select
'Range("H1").Select
'Selection.AutoFill Destination:=Range("H1:H" & lastrow)
'Range("H1:H" & lastrow).Select
'Range("L1").Select
'Selection.AutoFill Destination:=Range("L1:L" & lastrow)
'Range("L1:L" & lastrow).Select
End Sub
Any help in the right direction would be greatly appreciated. (Note I am just trying to fix Column A I figure if I can get that working the rest will fall into line).
Thanks!!!
-D
Is this what you are trying?
Option Explicit
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim Ret As Variant
Ret = MsgBox("Do you really want to save the workbook?", vbYesNo)
If Ret = vbNo Then
Cancel = True
Else
'~~> Make these changes only if user wants to save the workbook
Dim lrow As Long
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets(1)
With ws
'~~> If Col B has data then find the last row in Col B
lrow = .Range("B" & .Rows.Count).End(xlUp).Row
.Range("A1:A" & lrow).Formula = .Range("A1").Formula
End With
End If
End Sub
Related
I'm just starting with VBA and i'm stuck on a userform.
I am looking for a method that will allow me to click a command button and the text that is on that button will then appear in the last blank cell in a certain column. (for exemple in A2)
Private Sub CommandButton1_Click()
If MsgBox("Please confirm your choice ?", vbYesNo, "Confirmation") = vbYes Then
Worksheets("Sheet1").Select
ligne = Sheets("Sheet1").Range("A456541").End(xlUp).Row + 1
End If
Worksheets("Sheet1").Activate
Range("A2").Select Range("A2").Value = "Multiproject" & vbNewLine & vbNewLine
End Sub
After pen comment, my code looks like this :
Private Sub Multiproject_Click()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1")
Dim NextFreeCell As Range ' find next free cell in column A
Set NextFreeCell = ws.Cells(ws.Rows.Count, "A").End(xlUp)
If MsgBox("Please confirm your choice?", vbYesNo, "Confirmation") = vbYes Then
NextFreeCell.Value = "Multiproject" & vbNewLine & vbNewLine
End If
Unload FrmCustomMsgbo
End Sub
[1]: https://i.stack.imgur.com/4rGKP.png
Just find the next free cell and write the value there:
Option Explicit
Private Sub CommandButton1_Click()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1")
Dim NextFreeCell As Range ' find next free cell in column A
Set NextFreeCell = ws.Cells(ws.Rows.Count, "A").End(xlUp).Offset(RowOffset:=1)
If MsgBox("Please confirm your choice?", vbYesNo, "Confirmation") = vbYes Then
NextFreeCell.Value = "Multiproject" & vbNewLine & vbNewLine
End If
End Sub
You might benefit from reading
How to avoid using Select in Excel VBA.
And I highly recommend to give your command button a useful name CommandButton1 is not useful at all.
I need to create copies of entire workbooks (as there are other sheets, formatting, etc. I want to preserve) and then delete out rows of data that do not equal the current cl.value. The column headers will always be in row 1. The worksheet can have a varying amount of columns (i.e. A:D, A:F, A:G, etc.) and the end user can select any column to split by.
Referencing a cell works but if try to make it dynamic (based on user selection mentioned above) in the following part of the code:
Workbooks.Open Filename:=FName
'Delete Rows
'REFERENCING ACTUAL CELL WORKS
'Range("A1").AutoFilter 1, "<>" & cl.Value
'BELOW DOES NOT WORK
Range(ColHead).AutoFilter 1, "<>" & cl.Value
I get a
Run-time error '1004': Method 'Range' of object'_Global' Failed
Full Code Below:
Sub DisplayUserFormSplitWb()
UserFormSplitWb.Show
End Sub
Private Sub BtnOK_Click()
Call SplitWbMaster.SplitWbToFiles
End Sub
Private Sub UserForm_Initialize()
Dim SplitOptions As Range
Set SplitOptions = ActiveSheet.Range("A1", ActiveSheet.Range("A1").End(xlToRight))
SplitWbCol.List = Application.Transpose(SplitOptions.Value)
End Sub
Sub SplitWbToFiles()
Dim cl As Range
Dim OrigWs As Worksheet
Dim Subtitle As String
Dim ColValue As String
Dim ColStr As String
Dim ColNum As Long
Set OrigWs = ActiveSheet
ColValue = UserFormSplitWb.SplitWbCol.Value
Set ColHead = Rows(1).Find(What:=ColValue, LookAt:=xlWhole)
Set OffCol = ColHead.Offset(1, 0)
ColStr = Split(ColHead.Address, "$")(1)
ColNum = ColHead.Column
If OrigWs.FilterMode Then OrigWs.ShowAllData
With CreateObject("scripting.dictionary")
For Each cl In OrigWs.Range(OffCol, OrigWs.Range(ColStr & Rows.Count).End(xlUp))
If Not .exists(cl.Value) Then
.Add cl.Value, Nothing
'Turn off screen and alerts
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'Create workbook copy
FPath = "U:\"
Subtitle = UserFormSplitWb.SplitWbSubtitle.Value
FName = FPath & cl.Value & "_" & Subtitle & ".xlsx"
ActiveWorkbook.SaveCopyAs Filename:=FName
Workbooks.Open Filename:=FName
'Delete Rows
'REFERENCING ACTUAL CELL WORKS
'Range("A1").AutoFilter 1, "<>" & cl.Value
'BELOW DOES NOT WORK
Range(ColHead).AutoFilter 1, "<>" & cl.Value
ActiveSheet.ListObjects(1).DataBodyRange.Delete
Range(ColHead).AutoFilter
Range(ColHead).AutoFilter
'Rename sheet
ActiveSheet.Name = Left(cl.Value, 31)
'Refresh save and close
ActiveWorkbook.RefreshAll
ActiveWorkbook.Save
ActiveWorkbook.Close False
End If
Next cl
End With
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "Splitting is complete. Please check your Computer (U:) drive.", vbOKOnly, "Run Macro"
End Sub
To anyone who might stumble upon this question -
I have found that using the below code solves my issue:
ActiveSheet.Range("A1", ActiveSheet.Range("A1").End(xlToRight)).AutoFilter ColNum, "<>" & cl.Value
where:
Dim ColNum As Long
ColNum = ColHead.Column
I'm running into an issue with looping through tabs in my workbook. The code I am working on is supposed to perform the following:
Loop through all worksheets except the ones titled "BOAT" & "Data"
Select cell "A2" (A2 contains the value to filter)in each worksheet that it is looping through and use it as the autofilter value for the "Data" tab
Then copy and paste the filtered data into the respective tab that is looping through.
The issue I am running into is my code isn't picking up on the active sheet in the loop. Is there a way to create a variable to for the worksheet currently being looped through?
Code below. Thank you!
Sub updatedata()
Dim ws As Worksheet
Dim wsheet2 As Worksheet
For Each ws In ActiveWorkbook.Worksheets
If ws.name <> "BOAT" And ws.name <> "Data" Then
Call filter1
End If
Next ws
End Sub
Sub filter1()
Dim lastrow As Long
Dim lastrow2 As Long
Dim wSheet As Worksheet
Dim rInput As String
Application.DisplayAlerts = False
Set wSheet = ActiveSheet
rInput = wSheet.Range("A2").Value
Sheets("Data").Activate
lastrow = Range("A" & Rows.Count).End(xlUp).Row
ActiveSheet.Range("A1:Y" & lastrow).AutoFilter field:=4, Criteria1:="=*" & rInput & "*"
lastrow2 = Range("G" & Rows.Count).End(xlUp).Row
Range("G1:G" & lastrow2).Copy
wSheet.Activate
Range("A4").PasteSpecial xlPasteValues
Rows(4).EntireRow.Delete
Application.DisplayAlerts = True
End Sub
"Is there a way to create a variable to for the worksheet currently being looped through?"
Yes, using a Worksheet variable as an argument in filter1.
Avoid using Activate or making Range calls without specifying the Worksheet.
Sub updateData()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
If ws.Name <> "BOAT" And ws.Name <> "Data" Then
filter1 ws 'no need to use Call
End If
Next ws
End Sub
By passing ws as an Argument to filter1, all Range calls are fully qualified with the Worksheet in question. This is easily accomplished with a With...End With block - note the period . in front of .Range("A2").Value, .Range("A4"), etc - equivalent to myWs.Range("A2").Value, myWs.Range("A4")..., etc.
Sub filter1(myWs As Worksheet)
Dim lastRow As Long, lastRow2 As Long
Dim rInput As String
Application.DisplayAlerts = False
With myWs
rInput = .Range("A2").Value
With .Parent.Sheets("Data")
lastRow = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("A1:Y" & lastRow).AutoFilter field:=4, Criteria1:="=*" & rInput & "*"
lastRow2 = .Range("G" & .Rows.Count).End(xlUp).Row
.Range("G1:G" & lastRow2).Copy
End With
.Range("A4").PasteSpecial xlPasteValues
.Rows(4).EntireRow.Delete
End With
Application.DisplayAlerts = True
End Sub
The below code is deleting the records but I want to update the next column as "OK" instead of deleting entire row. Please advise as to what all changes are required.
Dim myFileNameDir As String
Dim ws1 As Worksheet
Dim iRow1 As Long
Dim str As String
myFileNameDir = "C:\Users\GShaikh\Desktop\Book16.xlsx"
Workbooks.Open Filename:=myFileNameDir, UpdateLinks:=0
Set ws1 = Worksheets("Students")
str = ListView1.SelectedItem.SubItems(1)
MsgBox str
With ws1
.AutoFilterMode = False
iRow1 = .Range("B" & .Rows.Count).End(xlUp).row
With .Range("B1:D" & iRow1)
.AutoFilter Field:=1, Criteria1:="=*" & str & "*"
.Offset(1, 0).SpecialCells (xlCellTypeVisible).EntireRow.Delete
End With
.AutoFilterMode = False
End With
ActiveWorkbook.Save
ActiveWorkbook.Close
You would need to remove: (xlCellTypeVisible).EntireRow.Delete
And replace it with something like Cells.Value = "OK"
I made a Sub. But its giving an error.!
I want to check if column A has values then it checks for columns" H and I ". those must be filled.
Else the file wont save..!!
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim cell As Range
Dim LastRow As Long
Dim oneRange As Range
Dim aCell As Range
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
If cell.Value(Range("A8:A" & LastRow)) Is Nothing Then
Exit Sub
Else
For Each cell In Range("H8:I" & LastRow)
If IsEmpty(cell.Value) Then
MsgBox "Please Select Value from Dropdown Menu...." & cell.Address
Application.Goto cell
Cancel = True
Exit For
End If
Next cell
End If
End Sub
TRIED AND TESTED
Is this what you are trying?
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim ws As Worksheet
Dim lRow As Long
Dim aCell As Range
Set ws = ThisWorkbook.Sheets("receivings")
With ws
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
If Application.WorksheetFunction.CountA(.Range("A8:A" & lRow)) = 0 _
Then Exit Sub
For Each aCell In Range("H8:I" & lRow)
If IsEmpty(aCell.Value) Then
MsgBox "Please Select Value from Dropdown Menu...." _
& aCell.Address
Application.Goto aCell
Cancel = True
Exit For
End If
Next aCell
End With
End Sub
sheet1 and sheets(1) is often not the same. Best is using the name of the sheet.
You might miss a "." at the second for (...in .range...) ?
PS, i'm new in VBA, what does application.goto aCell, do ? because it strage to put a "exit for" after a "goto"...