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
return number of unique dates on another sheet in the same workbook
I have a project for work where I am trying to calculate the total number of days an employee worked, with data from one sheet feeding the number calculated on the same sheet, or another sheet in the same workbook.
There are several rows of data for each work day, and so I am looking to calculate the total number of unique dates for each employee separately. If the data is isolated to one employee then I can use:
to calculate the number of work days. I have tried using several additional formulas to get the value I'm looking for, including:
=SUMPRODUCT((TEXT('Data'!$A$1:$A$100, "yyyymm")="201804")*('Data'!B$1:$B$100="John Doe"))
=SUMIFS(IF(FREQUENCY('Sono Detail'!$B:$B,'Sono Detail'!$B:$B)>0,1),'Sono Detail'!$E:$E,'(Test) Sono Report Card 1.0'!$B$3)
Neither of these worked.
Sending out a chain of e-mails in Outlook
I have a question about the capabilities in VBA for outlook.
I often reach out to brands in order to acquire their product data.I find that they are not usually amenable to providing me data after a single e-mail. I have a chain of e-mails that I send out on a weekly basis/monthly basis to brands. Each e-mail builds off of the previous e-mail. I also have some information within the e-mail that is specific to the brand in question. I currently have a system of e-mailing that requires me to manually copy and paste the necessary information, and then re-arrange the key fields so they are correct, and then send it out.
I see that there is a way to send out single e-mails through outlook with VBA. What I'd like to do is set up an excel sheet that VBA would pull from, populate the appropriate fields correct content with the relevant field, and then send it out. When the second e-mail is due to go out, I'd like it to be a reply to the previous e-mail that was sent out. I can forgo this though if that is necessary.
I know VBA in excel, but I'm a journeymen user of it and am definitely not capable of someone writing this type of code. Is there anyone out there who knows if this is possible, and if so can send out a prototype that I can build off of?
This is what I have so far:
Sub Item_PropertyChange(ByVal Name) Select Case Name Case "Status" if Item.Status = 2 then '2 = Completed Set NewItem = Application.CreateItem(0) NewItem.To = "firstname.lastname@example.org" NewItem.Recipients.ResolveAll NewItem.Subject = "This is the message subject text" NewItem.Body = "This is text that will appear in the body of the message." NewItem.Display End IF End Select End Sub
VBA/Excel flat hierarchy -> sunburst plot
I have flat hierarchical data in a named range "Table1" that looks like below, where the "#" is the value for each Category, and The "#" is the sum of the current level and all child levels. If the input data is selected, can VBA get this into a format to use the Sunburst plot?
# ## Lvl Name 2 5 A1 2 7 A2 2 2 8 A3 10 5 B1 5 7 B2 5 5 8 B3 5 7 B4 5 8 B5 5 5 9 A6 3 5 C1 2 7 C2 2 8 C3 1 9 C4 1 1 10 C5 1 9 C6 1 10 C7 1 1 11 C8 1 7 C9 1 8 C10 1 1 9 C11
The output table would look like this:
L5 L7 L8 L9 L10 L11 Count A1 A2 A3 2 B1 B2 B3 5 B4 B5 B6 5 C1 C2 C3 C4 C5 1 C6 C7 C8 1 C9 C10 C11 1
And the plot would look like this: https://imgur.com/NcH6g0s
Excel VBA cant get looping transfer code to work
Im attempting to write some VBA that will Copy completed tasks from a list and move them to another sheet in the same workbook but my code keeps giving me the loop without Do error even though it seems i have both. Here is what I have so far:
Sub RemoveOld() 'define varibles Dim x As Long Dim v As Variant, r As Range, rWhere As Range 'set starting point at row 3 x = 3 'defines the sheet the data is being coppied from and pasted to Dim sourceSheet As Worksheet: Set sourceSheet = ThisWorkbook.Worksheets("Front Page") Dim destSheet As Worksheet: Set destSheet = ThisWorkbook.Worksheets("History of Tasks") 'says to run the script as long as column H is not blank Do While Range("H" & x).Value <> "" 'Checks if the satus is complete or submitted If Range("H" & x).Value = "Completed" Then 'selects the next row where the 1st column is empty lMaxRows = destSheet.Cells(destSheet.Rows.Count, "A").End(xlUp).Row 'pastes the data from the specified cells into the next empty row destSheet.Range("A" & lMaxRows + 1).Value = sourceSheet.Range("B" & x).Value destSheet.Range("B" & lMaxRows + 1).Value = sourceSheet.Range("C" & x).Value destSheet.Range("C" & lMaxRows + 1).Value = sourceSheet.Range("D" & x).Value destSheet.Range("D" & lMaxRows + 1).Value = sourceSheet.Range("E" & x).Value destSheet.Range("E" & lMaxRows + 1).Value = sourceSheet.Range("F" & x).Value destSheet.Range("F" & lMaxRows + 1).Value = sourceSheet.Range("G" & x).Value destSheet.Range("G" & lMaxRows + 1).Value = sourceSheet.Range("H" & x).Value 'Moves the program down to the next line x = x + 1 Else 'Checks if the satus is complete or submitted If Range("H" & x).Value = "Uploaded" Then 'selects the next row where the 1st column is empty lMaxRows = destSheet.Cells(destSheet.Rows.Count, "A").End(xlUp).Row 'pastes the data from the specified cells into the next empty row destSheet.Range("A" & lMaxRows + 1).Value = sourceSheet.Range("B" & x).Value destSheet.Range("B" & lMaxRows + 1).Value = sourceSheet.Range("C" & x).Value destSheet.Range("C" & lMaxRows + 1).Value = sourceSheet.Range("D" & x).Value destSheet.Range("D" & lMaxRows + 1).Value = sourceSheet.Range("E" & x).Value destSheet.Range("E" & lMaxRows + 1).Value = sourceSheet.Range("F" & x).Value destSheet.Range("F" & lMaxRows + 1).Value = sourceSheet.Range("G" & x).Value destSheet.Range("G" & lMaxRows + 1).Value = sourceSheet.Range("H" & x).Value 'Moves the program down to the next line x = x + 1 Else x = x + 1 End If Loop End Sub
Then after I get this working I want it to go through ad delete the rows i just copied but in the mean time im just trying to get the copy function to work.
Any help would be greatly appreciated
here is what the table looks like:
Removing Data Labels with values of zero then reset - VBA
I have a code that removes the data label(s) from a customized pie chart if the value of the cell is 0%. However, since my code loops so that the data changes, i completely lose the label for that particular category so when a new set of data is added and the value is not zero the label does not appear any more. How do I do it so that when the value is 0 the data label is removed but when the value is anything but zero then it would reappear, essentially resetting the original set up of the chart so that all values/categories have data labels.
Sub ChartLoop() Range("D2").Select ActiveCell.Range("C1:E1").Select Dim myPDF As String Dim i As Long For counter = 2 To 21 Sheets("CF").Select Range("'CF'!$D$" & counter & ":$F$" & counter).Select 'numbers Selection.Copy Sheets("CF-Chart").Select Range("B1:B3").Select Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True 'this is for removing the data labels Dim iPts As Integer Dim nPts As Integer Dim aVals As Variant Dim srs As Series ActiveSheet.ChartObjects("Chart 5").Activate For Each srs In ActiveChart.SeriesCollection With srs If .HasDataLabels Then nPts = .Points.Count aVals = .Values For iPts = 1 To nPts If aVals(iPts) = 0 Then .Points(iPts).HasDataLabel = False End If Next End If End With Next ActiveSheet.ChartObjects("Chart 5").Activate ActiveChart.ChartArea.Select myPDF = "\\stchsfs\arboari$\Profile-Data\Desktop\Export Trial1\c2-" & Sheets("CF").Range("C" & i + 2).Value2 & ".pdf" ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=myPDF, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False i = i + 1 Next counter End Sub
The first chart is how my regular chart would look like. The second chart is where I would want to remove the data label with the value 0 but keep the data label with categories and value for the other ones with value >0.
Can't access an excel pivot table field through a string value in VBA
I am trying to access a row field in an Excel Spreadsheet through a VBA Macro
Sub EnableSelectionSelPF() 'pivot table tutorial by contextures.com 'This is the Excel Module that will enable 'the selection for a single piviot table 'column on the first table of the sheet Dim PT As PivotTable Dim PF As PivotField Dim Column As String Column = "Service Address" On Error Resume Next Set PT = ActiveSheet.PivotTables(1) Set PF = PT.RowFields(Column) PF.EnableItemSelection = True End Sub
When replacing the column string variable with a numerical index value I'm able to access the desired field, however trying to use the string variable,
Column, or a string value as the Index yields no results for me.
I've checked to make sure that
PT.RowFields()could take string values so I'm not quite sure what the problem is.
Base Code Acquired From: Contextures
Google Sheet Script - Vlookup and paste values
On edit and if the codes of column 'Code' match, I want the values in column 'Completed by Crew' of the 'Today' sheet to be pasted into the correct rows of 'Completed by Crew' column in 'Input Tab'.
The data in 'Today' will change everyday as it refers to the inspections for the current date and also on the manager's name in 'Select Manager'.
I have created a unique code for every entry in 'Input Tab'. In order to find the correct correct row to paste the values into I was thinking I could use a vlookup of this code within the script? I would like to understand how to write this vlookup for the codes to match and then for the values to be pasted.
I would also like for the cell value in the 'Completed by Crew' column to be reset to blank when 'Select Manager' name changes and for every new day. Is this possible?
Any help would be much appreciated.
Copy the values only between worksheets
I am using this line to copy some sheets between two workbooks
but it copys the equations not the values so it result to empty cells in
How can I copy the values only between them?
VBA code to copy data from the last row with data, count up a set number of rows, then paste in the row below the last row with data
Requirement: I have a spreadsheet that I would like to copy from a#,a#...the rows grow each week so there is no set number or range but the number of rows each week will be the same so I would like to copy data starting from the last row (a#,m#) all the up to the first row in that range (a#,m#)
Example: copy from a130714,m133731 and past on a133732 the following week when I execute the code it will copy fromthe last row (in the A#,M# range) up to the a133732,m133732 range.
Selection.End(xlDown).Select Selection.End(xlToLeft).Select ActiveWindow.ScrollRow = 133350 ActiveWindow.ScrollRow = 125080 ActiveWindow.SmallScroll Down:=-21 ActiveWindow.SmallScroll ToRight:=6 Range("A130714:M133731").Select Range("A133731").Activate Selection.Copy Selection.End(xlDown).Select Selection.End(xlUp).Select Selection.End(xlToLeft).Select Range("A133732").Select ActiveSheet.Paste
Select and copy a specific number of filtered rows using VBA in excel
I'm using AutoFilter on a huge list and want to copy the first visible 200 rows. My code is static since it only select down to row 201. I want to have a dynamic code where I select the first visible 200 rows when filter is used (excluding header). This is how my code looks today:
Sheets("Sheet1").Select Range("A2:A201").Select Application.CutCopyMode = False Selection.Copy Sheets("Sheet2").Select Range("A1").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False
Restoring AutoFilter with xlFilterValues raises error 13 Type mismatch if Len(Criteria1(i))>255?
I've inherited some VBA code that attempts to save and restore filters in Excel 2010-2016 (I'm testing on Excel 2016 - 32bit, 16.0.4549.1000). I've already learned this is pretty much impossible to do properly and in a sane way (e.g. Get Date Autofilter in Excel VBA), but the number of way it can fail amazes me.
In particular, it seems that an
xlFilterValuesfilter, which selects cells with value longer than 254 characters, can not be saved and restored:
- the values in
.Criteria1(i)are truncated to 256 chars when reading,
- if you save the criteria array (
saved = .Criteria1) and attempt to restore it later via
.AutoFilter Criteria1:=saved ..., the
.AutoFilterwill report "Run-time error '13' Type Mismatch" if any Len(saved(i)) >= 256
The testcase, which can be run in an empty workbook is listed below.
Can everyone reproduce? Any thoughts on an easy way around this limitation?
Sub test() Const CRITERIA_LEN = 257 ' 255 or less works, 256 throws error Dim ws As Worksheet: Set ws = ActiveSheet Dim filtRng As Range: Set filtRng = ws.Range(ws.Cells(1, 1), ws.Cells(5, 1)) Dim s100 As String: s100 = "1234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890" Const PREFIX_LEN = 2 ' the length of the "=X" prefix in Criteria1(i) Dim longStr As String: longStr = Mid(s100 & s100 & s100, 1, CRITERIA_LEN - PREFIX_LEN) ws.Cells(1, 1).Value2 = "header" ws.Cells(2, 1).Value2 = "A" & longStr ws.Cells(3, 1).Value2 = "B" & longStr ws.Cells(4, 1).Value2 = "C" & longStr ws.Cells(5, 1).Value2 = "another value" If Not ws.AutoFilterMode Then filtRng.AutoFilter End If SET_BREAKPOINT_HERE = 1 ' after hitting the breakpoint use the autofilter to select the three long values by typing '123' into the autofilter search Dim fs As Filters: Set fs = ws.AutoFilter.Filters If Not fs.Item(1).On Then Exit Sub Debug.Print "Operator = " & fs.Item(1).Operator ' should be xlFilterValues (7) Debug.Print "Len(.Criteria1(1)) = " & Len(fs.Item(1).Criteria1(1)) ' this is never larger than 256 Debug.Print "Len(.Criteria1(2)) = " & Len(fs.Item(1).Criteria1(2)) Debug.Print "Len(.Criteria1(3)) = " & Len(fs.Item(1).Criteria1(3)) ' Save the filter Dim crit As Variant crit = fs.Item(1).Criteria1 'crit = Array("=A" & longStr, "=B" & longStr, "=C" & longStr) ' This line has the same effect ws.AutoFilter.ShowAllData ' reset the filter ' Try to restore filtRng.AutoFilter Field:=1, _ Criteria1:=crit, _ Operator:=xlFilterValues ' => Run-time error '13' Type Mismatch End Sub
- the values in
excel autofilter using xlAnd and xlOr
I know I can technically only have two criteria with Autofilter.
I also know I can use an array to "add" more to an "And" or "Or" situation.
Example I found:
Range("A1").CurrentRegion.AutoFilter _ Field:=1, _ Criteria1:=Split("France#Belgium#Germany", "#"), _ Operator:=xlFilterValues
However, I want to filter a column to all fields between two dates (one year) and include blanks.
There has to be a better way than making an array of every date for an entire year like I am thinking....?
This is one variation I have tried that doesn't work...
Range("A1:AV1").AutoFilter Field:=5, Criteria1:="=", Operator:=xlOr, Criteria2:=">=1/1/2018", Operator:=xlAnd, Criteria3:="<=12/31/2018"
Help! Please! Thanks,