Autofilter then Copy and Paste Range
I wrote a code below. Intention is to autofilter column K with criteria, copy data and paste it at the bottom of the sheet on the same page, just below the last row.
I am not getting any error, but code is not working as intended. It works up to autofilter and copy, but it won't paste the data to the last row. Can I please get some assistance.
Sub Depreciation_to_Zero() With Sheets("Restaurant") .AutoFilterMode = False With .Range("k1", .Range("k" & .Rows.Count).End(xlUp)) .AutoFilter Field:=1, Criteria1:="*HotDog*" On Error Resume Next .Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Copy .Cells(.Rows.Count, "A").End(xlUp).Row.Select.PasteSpecial xlPasteValues On Error GoTo 0 End With .AutoFilterMode = False End With MsgBox ("Complete") End Sub
Try this version
Option Explicit Public Sub DepreciationToZero() Const FIND_VAL = "*HotDog*" Dim ws As Worksheet, lr As Long, result As String Set ws = Worksheets("Restaurant") Application.ScreenUpdating = False ws.AutoFilterMode = False lr = ws.Cells(ws.Rows.Count, "K").End(xlUp).Row result = FIND_VAL & " not found" With ws.UsedRange ws.Range("K1:K" & lr).AutoFilter Field:=1, Criteria1:=FIND_VAL If ws.Range("K1:K" & lr).SpecialCells(xlCellTypeVisible).CountLarge > 1 Then .Offset(1).Resize(lr - 1).SpecialCells(xlCellTypeVisible).Copy .Offset(lr).Cells(1).PasteSpecial xlPasteValues .Offset(lr).Cells(1).Select Application.CutCopyMode = False result = "All " & FIND_VAL & " rows copied" End If End With ws.AutoFilterMode = False Application.ScreenUpdating = True MsgBox result End Sub
See also questions close to this topic
Android app that reads/writes cell values in googlesheets
Simply as it should be; I'm creating a simple android app that uses Google Sheets as a database.
- My android app should send a request with the cell number (row & column) to the google spreadsheet (in JSON or whatever easier).
- My android app gets the return as cell value (in JSON also or whatever).
- My android app checks received cell value & based on the check, the android app might send a request to the spreadsheet to rewrite cell value.
My problem is how to do it on android side .. searched a lot & found complicated results .. the task is simple & I need very simple code.
Also I know it might involve doing app-script for the spreadsheet .. but that would be easier for me.
PS >> I'm not lazy about reading the whole API but I've no time & all I need is read/write cell value. Thanks all ..
Double condition Fibonacci sequence
I'm trying to create a Fibonacci sequence which incrementation depends on one column and the restart depends on another column.
Given columns A and B, I'd like to calculate FIB:
A | B |FIB ---|---|--- 1 | T | 0 2 | T | 1 0 | F | 2 | T | 1 2 | T | 2 0 | T | 3 2 | F | 1 | F | 2 | T | 5 0 | F | 1 | T | 0 2 | T | 1 0 | F | 0 | T | 1 2 | T | 2
When A=1 I want FIB to restart the Fibonacci sequence.
When B=T I want FIB to increment.
Do you see any way, without VB, to do this?
Calculate interval between two dates with two columns each
I need to calculate a time interval, where my data is arranged the following way: I have column A with a date of the start of a event, and colum B with the hour:minute start of the event. The same for C with date of end of a event, and D with the hour:minute end of the event. I want to calculate the diferences in minutes between the start and end. The start date can be in diferent days and months, so i can't just substract the time.
I'm having trouble running a VBA macro on 64-bit MacOS
I'm having trouble running a VBA macro on 64-bit MacOS. I'm trying to run the following code snippet in the Visual Basic Editor on MacOS.
Option Explicit Private Declare PtrSafe Function system Lib "libc.dylib" (ByVal command As String) As LongPtr Sub autoopen() Fisher End Sub Sub Fisher() system ("open -a Safari --args http://www.google.com") End Sub
The error I'm getting is that libc.dylib cannot be found. I have tried specifying the explicit path for the dylib and the same error is thrown. I'm having trouble debugging this issue and can't seem to find any help from googling the error, could anyone help me figure out what's going on?
Transforming Data into a timeline
Im trying to transform my data that currently looks like this:
I was attempting to use the find function with a loop running through each user and then just putting the times adjacent to each corresponding user. But I cannot figure out how to get the find function to run multiple times after finding the first occurrence but also finding the minimum and then second minimum time etc...
Im open to other suggestions for VBA
CommandBars("Tools").Controls not deleted when exiting the document - VBA word add-in
I'm trying to apply the procedure below to create a add in for MS Word with VBA https://bettersolutions.com/word/WCA723/NI825618332.htm
All the procedure works fine. The only issue is in the routine bellow:
Public Sub AutoExit() Dim objcommandbutton As CommandBarControl Call MsgBox("AutoExit") For Each objcommandbutton In Application.CommandBars("Tools").Controls If objcommandbutton.Caption = "How Many Pages?" Then objcommandbutton.Delete End If Next objcommandbutton End Sub
When exiting the document, the Command Button previously added in CommandBars("Tools") collection is not deleted. I see this when I open a new blank Word document and the button remains in the "add-ins tab".
I know that the routine is performed correctly because there is a MsgBox instruction to verify it. This only happen with the AutoExit subroutine of a add-in: running the code in a macro with vba module works fine.
Unable to switch to a new tab in an efficient manner
I've written a script in vba which is able to click on a certain link (
Draw a map) of a webpage. When the clicking is done, a new tab opens up containing information I would like to grab from. My script can do all these errorlessly. Upon running the script it scrapes the title visible as
Make a Google Map from a GPS filefrom the new tab.
My question: is there any alternative way to switch to new tab other than using hardcoded search like
If IE.LocationURL Like "*" & "output_geocoder" Then?
This is my script:
Sub FetchInfo() Const url As String = "http://www.gpsvisualizer.com/geocoder/" Dim IE As New InternetExplorer, Html As HTMLDocument, R& Dim winShell As New Shell With IE .Visible = True .navigate url While .Busy = True Or .readyState < 4: DoEvents: Wend Set Html = .document End With Html.querySelector("input[value$='map']").Click For Each IE In winShell.Windows If IE.LocationURL Like "*" & "output_geocoder" Then IE.Visible = True While IE.Busy = True Or IE.readyState < 4: DoEvents: Wend Set Html = IE.document Exit For End If Next Set post = Html.querySelector("h1") MsgBox post.innerText IE.Quit End Sub
To execute the above script, add this reference to the library:
Microsoft Shell Controls And Automation Microsoft Internet Controls Microsoft HTML Object Library
Btw, there is nothing wrong with the above script. I only wish to know any better way to do the same.
Userform initialize checks then close
I have a userform. The idea is to check if there are any 'True' values in column(15) in 'Admin' sheet. If there is at least a single 'True' value, then the userform will remain open and continue its operation.
However, if there is not a single 'True' found, then the userform will display a message and close the userform automatically.
Private Sub Userform_initialize() Dim LR As Long LR = Sheets("Project_Name").Cells(Rows.Count, "B").End(xlUp).Row With Worksheets("Admin") For i = 7 To LR If .Cells(i, 15) = "True" Then Exit For Else MsgBox ("No values found") Exit For Unload Me End If Next i End With ''' more code''' End Sub
Everything on my userform works as expected, except for the fact I am unable to make it close itself automatically. I.e. Unload Me is not working.
Changing files while copying and pasting them
What happens if i copy and paste a folder with lots of files and i change a few ones (from the source) while the files are being copied? Will the files be copied with new changes or the previous? Or depends on the OS? I use Windows 10 Education
Copy and Paste a Row into Another Sheet using a CheckBox
I am creating a list of customer information and another list of customers who I would like to send a letter to in excel. I would like to click a checkbox and have the customers information in that row copied and pasted into the next available line in the other list.
The customer information is on sheet1 (renamed Customers), beginning in column B row 2, ending in column K. The checkbox is in column L and linked to column M.
The list I would like to copy the information to is the same set up, but without the checkbox, on sheet2 (renamed Cleaning List).
I have written a formula to move the information after checking the box, I used
But I have to create a new formula for each box and it doesn't allow for the information to be copied into the next available row.
Excel VBA Copy/Paste Between Range of Workbooks
I used to code in VBA frequently, but its been a few years and I am stumped. Have an issue with the following code that seems to work fine (although very slowly) for the first 9 files it is opening / copying from, then I get a macro error and it results in an excel hang-up requiring restart. I borrowed / modified heavily an earlier post from luke_t on this forum to get this far. As far as I can tell, there is no difference in the 9th file as they are all based on a standard template, but the error could be there?
Sub copy_rng() Dim wb As Workbook, wbDest As Workbook, ws As Worksheet, wsDest As Worksheet, wsSrc As Worksheet Dim wbNames() As Variant Dim destPath As String Dim fullpath As String Dim outputrow As Variant, i As Byte Set wb = ThisWorkbook Set ws = wb.Sheets("Casing") Set wsSrc = wb.Sheets("Casing") wbNames = ws.Range("b5:b" & lrow(2, ws)) destPath = "C:\Users\...\Daily Reports\" outputrow = 5 Application.ScreenUpdating = False For i = 1 To UBound(wbNames, 1) fullpath = destPath & wbNames(i, 1) MsgBox i & " " & fullpath 'Stop Set wbDest = Workbooks.Open(destPath & wbNames(i, 1)) Set wsDest = wbDest.Sheets("Field Report (Internal)") With wsDest .Range(Cells(27, 17), Cells(27, 19)).Copy End With wsSrc.Cells(outputrow, 10).PasteSpecial xlPasteValues With wsDest .Range(Cells(28, 17), Cells(28, 19)).Copy End With wsSrc.Cells(outputrow, 13).PasteSpecial xlPasteValues With wsDest .Range(Cells(29, 17), Cells(29, 19)).Copy End With wsSrc.Cells(outputrow, 16).PasteSpecial xlPasteValues Application.CutCopyMode = False wbDest.Close False outputrow = outputrow + 1 Next i Application.ScreenUpdating = True End Sub Function lrow(ByVal col_num As Integer, sheet_name As Worksheet) As Long lrow = sheet_name.Cells(Rows.Count, col_num).End(xlUp).Row End Function
Excel vba macro to delete rows in one sheet that do no match those in another using auto filter via input box
this is my first post, I am and novice user and would really like some help. I have been searching for a week to no avail. I have 2 Sheets (Sheet1 and Sheet2) with a small macro assigned to delete any rows in Sheet1 which do not match those in Sheet2. I am also using a InputBox to capture the user defined criteria based on field 4, which works great and filters correctly. My problem is related to the second part as the deletion is performed for matches across the whole of Sheet1 (ignoring the filter). What I want is for the deletion to occur only on those rows filtered by by the user. Any help would be gratefully received, if you could annotate your answers that would be helpful and apologies if I am making rookie mistakes.
Sub DeleteRows() 'Deletes rows where one cell does not meet criteria Dim ws1 As Worksheet: Set ws1 = ActiveWorkbook.Sheets("Sheet1") Dim ws2 As Worksheet: Set ws2 = ActiveWorkbook.Sheets("Sheet2") Dim criteria As String Dim found As Range Dim i As Long Dim Area As String Dim Data As Variant 'Auto filters by user selection Area = InputBox("Enter your required Building(s) - comma separated") If InStr(1, Area, ",") > 0 Then Data = Split(Area, ",") Range("A1").AutoFilter Field:=4, Criteria1:=Trim(Data(0)), Operator:=xlOr, Criteria2:=Trim(Data(1)) Else Range("A1").AutoFilter Field:=4, Criteria1:=Area End If 'Deletes all rows from Sheet1 that do not match For i = 2 To 100 criteria = ws1.Cells(i, 1).Value On Error Resume Next Set found = ws2.Range("A:A").Find(What:=criteria, LookAt:=xlWhole) On Error GoTo 0 If found Is Nothing Then ws1.Cells(i, 1).EntireRow.Delete i = i - 1 End If Next i End Sub
VBA Get Values from AutoFilter
Let's say I have very large set of data with over 100,000+ rows. In Column A, I want to find each unique number.
I understand this can be done using the .Find feature and Collections/Arrays but those seem to take a good bit of time - especially with 100,000+ rows.
However, after AutoFiltering Column A, when I hit the down arrow it displays only unique variables. Is it possible to simply extract those values out of the selections in this way?
'pseudocode filter.Count Dim X As Long For x = 2 to filter.Count Cells(x, 14) = filter(x) Next x
VBA Autofilter Using Multiple Criteria
I am trying to filter on multiple criteria within VBA.
However I cannot find a simple way of doing this. The criteria I am selecting will always be constant but greater than 2 therefore I cannot use the or operator.
Selection.AutoFilter field:=10, Criteria1:=Array("Fixtures & Fittings", "Furniture & Equipment", "Land & Buildings", "Motor Vehicles", "Plant & Machinery")
My current solution only filters on the last criteria within the array.
Due to the file set up I am unable to insert a formula in another column.