I'm trying to copy data into new workbook and validate the data by removing duplicates keeping one cell value as the source.
All I wanted is the count of XD in the worksheet provided there are no duplicate Record locator.
Also I wanted the count to be in a msgbox. Can someone help ?
Sub openworkbook()
Workbooks.Open ("C:\Users\kjayachandiran\Desktop\ACUITY CF 1204-1210.xls")
Worksheets(2).Activate
Cells.Select
Selection.Copy
Workbooks.Open ("C:\Users\kjayachandiran\Desktop\New-Manjunath.xlsx")
Worksheets(1).Activate
Range("A1").Select
ActiveSheet.Paste
Workbooks(3).Save
Workbooks(2).Close
ActiveWorkbook.Activate
Worksheets(1).Activate
Cells(1, 1).Select
Range("A366655").Value = Application.WorksheetFunction.CountIf(Columns(9), "=" & "XD")
End Sub
Related
I want to copy data from sheet "summary" row A44 (fixed row with dynamic data with formula) to sheet18 (row A3), A1 and A2 are header; i have below vba code and manage to do so. I would like to copy and paste the data as value (like Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False), so that the data will convert to absolute number, anyone how to edit the code?
Sub COPY_SUMMARY2COPYDATA()
Set des = Sheet18.Range("a1")
With Worksheets("SUMMARY")
.Rows(Range("A44").Row).Copy
des.Range("A3").Insert Shift:=xlUp
End With
Application.CutCopyMode = False
End Sub
Please try this:
Sub COPY_SUMMARY2COPYDATA()
Dim LastRow As Long
LastRow = Sheet18.Cells(Rows.Count,1).End(XlUp).Row + 1
Sheets("SUMMARY").Rows("44").Copy
Sheet18.Rows(LastRow).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End Sub
Hope this help
To find the first blank cell in column A look from the bottom up and offset down one row.
Use a direct value transfer with .Value2 to pass over 'the data will convert to absolute number'. This will discard regional currency and date conventions as well as formulas in favor of the raw underlying value.
with Worksheets("SUMMARY")
with intersect(.usedrange, .rows(44).cells)
Sheet18.cells(.rows.count, "A").end(xlup).offset(1, 0).resize(.rows.count, .columns.count) = .value2
end with
end with
I'm not really sure how to use Autofilter for this but I am creating a new worksheet and I'm trying to filter another sheet based on two criterias. I then need to copy the values from only 2 of the columns from that worksheet to the new worksheet. This is the code I have so far:
Private Sub Workbook_Open()
Dim ws As Worksheet
Set sheet = Sheets.Add(After:=Sheets(Worksheets.Count))
ActiveSheet.Range("A11").Value = "Projects in Loss:"
ActiveWorkbook.Sheets("Fielding").Activate
ActiveSheet.ShowAllData
ActiveWorkbook.Sheets("Fielding").Activate
ActiveSheet.ShowAllData
Selection.AutoFilter field:=15,
Criteria:=ActiveWorkbook.Sheets(Target).Range("A3").Value, Operator:=xlAnd
Selection.AutoFilter field:=21, Criteria:="<30%" & ">0"
ActiveSheet.Columns("A").Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
ActiveWorkbook.Sheets(ws).Activate
ActiveSheet.Range("A12").PasteSpecial xlPasteValues
Application.CutCopyMode = False
ActiveWorkbook.sheet ("Fielding")
ActiveSheet.Columns("U").Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
ActiveWorkbook.Sheets(ws).Activate
ActiveSheet.Range("B12").PasteSpecial xlPasteValues
Application.CutCopyMode = False
End Sub
It keeps giving me a run time error '1004'. Does anyone know what I'm doing wrong or could direct me in the right direction?
Selection.AutoFilter field:=21, Criteria:="<30%" & ">0"
The way to do this is by putting two different criteria with xlAnd operator
Selection.AutoFilter field:=21, Criteria1:=">0", Operator=xlAnd, Criteria2 = "<0.3"
Also, there's no parameter Criteria in the AutoFilter method. It's Criteria1 and optionally another parameter Criteria2 (change Criteria to Criteria1 at other places in your code).
Working with Selection is hazardous and source of bugs. You should really try to rewrite your code without the Selection stuff. Take a look at How to avoid using Select in Excel VBA macros
i have 2 CSV files orders_by_user_backlog and orders_by_user_pivot. I want to create with VBA an .xlsx file called Orders by Users Report containing 2 sheets.
First sheet called backlog, i will just copy the data from orders_by_user_backlog.csv and paste it there.
Second sheet called pivot, i will copy the data from orders_by_user_pivot.csv and paste it there and refresh the pivot table in the same sheet with the new data.
I am using an .xlsx file as template called Orders By Users Template
Here is my code
Sub Orders_by_User_report()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'open the csv output from query orders by user backlog
Workbooks.Open FileName:="C:\Reports\orders_by_user_backlog.csv"
Cells.Select
Selection.Copy
Workbooks.Open FileName:= _
"C:\Reports\Report templates\Orders By Users Template.xlsx"
Sheets(1).Select
Cells.Select
ActiveSheet.Paste
'Bold and color top row, add autofilter, zoom 80% and autofit
Range("A1:H1").Select
Selection.Interior.Color = 255
Selection.Font.Bold = True
Selection.AutoFilter
ActiveWindow.Zoom = 80
Cells.Select
Cells.EntireColumn.AutoFit
'open the csv output from query orders by user pivot
Workbooks.Open FileName:="C:\Reports\orders_by_user_pivot.csv"
Cells.Select
Selection.Copy
Workbooks.Open FileName:= _
"C:\Reports\Report templates\Orders By Users Template.xlsx"
Sheets(2).Select
Cells.Select
ActiveSheet.Paste
'Bold and color top row, add autofilter, zoom 80% and autofit
Range("A1:D1").Select
Selection.Interior.Color = 255
Selection.Font.Bold = True
Selection.AutoFilter
ActiveWindow.Zoom = 80
Cells.Select
Cells.EntireColumn.AutoFit
'refresh pivot table
Sheets(2).Select
ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh
'save file as xlsx for the output
ActiveWorkbook.SaveAs FileName:= _
"C:\Reports\Orders by Users\Orders by Users Report " & ".xlsx" _
, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWindow.Close
ActiveWindow.Close
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
I know where is my problem, it's in the 'ActiveSheet' but i didn't know how to fix it. Everytime i am using
ActiveSheet.Paste
or
ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh
it shows me error in the second ActiveSheet.Paste, when i comment this part and try only with one CSV file it Pastes fine but then it stops again in the ActiveSheet.PivotTables.
Can anyone please advice me what to change in my code ? Thank you very much.
Assign parentage to your objects and work directly with the objects. It's cleaner, easier to read and debug and ensures you are working directly with the objects you want.
Code below is untested (and only deals with the question at hand).
Dim wbBacklog as Workbook, wbPivot as Workbook, wbTemplate as Workbook
Set wbTemplate = Workbooks.Open("C:\Reports\Report templates\Orders By Users Template.xlsx")
Set wbBacklog = Workbooks.Open("C:\Reports\orders_by_user_backlog.csv")
Set wbPivot = Workbooks.Open("C:\Reports\orders_by_user_backlog.csv")
wbBacklog.Sheets(1).UsedRange.Copy 'copy data
wbTemplate.Sheets(1).Range("A1").PasteSpecial xlPasteValues 'paste to template
wbPivot.Sheets(1).UsedRange.Copy 'copy data
wbTemplate.Sheets(2).Range("A1").PasteSpecial xlPasteValues
Also, to make it easier, define a dynamic named range for the data source of the PivotTable. SOmething like this formula.
=Offset(Sheet2!A1,0,0,counta(Sheets2!A:A),4)
Then, in your code,
wbTemplate.Sheets(2).PivotTables(1).Refresh
will work.
Lastly, read and study how and why to Avoid Select. It's a must in VBA programming in Excel.
I'm interning and was given an assignment in VBA, which I know very little about. I found code that is similar to the functions I need and have commented it with my best guesses. If you could help me understand what each piece does and where to replace the generic code with my own information, it would be greatly appreciated!
When patrons have an overdue record, they are sent a spreadsheet with a list of the records they must return and the records' attributes in the following columns.
I need to create a macro which will
Create a new workbook
Copy row 1 (headings)
Copy rows with the same User
Name the file “UniqueUserrecordsrecall.xlsx”
Save to C:\Users\xxx\Documents\xxx\xxx
Attributes: Records, Description, Client, Engagement, Days, Date, Type, LOS, Location, State, Final, User.
Workbook Name: RecordsRecall
Worksheet Name: Main
Sub details()
'Declaration
Dim thisWB As String
Dim newWB As String
thisWB = ActiveWorkbook.Name
'?
On Error Resume Next
Sheets("tempsheet").Delete
On Error GoTo 0
'CreateTempSheet
Sheets.Add
ActiveSheet.Name = "tempsheet"
'?
Sheets("Main").Select
If ActiveSheet.AutoFilterMode Then
Cells.Select
On Error Resume Next
ActiveSheet.ShowAllData
On Error GoTo 0
End If
'Copy User Column
Columns("L:L").Select
Selection.Copy
'Paste User Column in TempSheet
Sheets("tempsheet").Select
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
'?
If (Cells(1, 1) = "") Then
LastRow = Cells(1, 1).End(xlDown).Row
If LastRow <> Rows.Count Then
Range("A1:A" & LastRow - 1).Select
Selection.Delete Shift:=xlUp
End If
End If
'Apply Unique Filters in Tempsheet
Columns("A:A").Select
Columns("A:A").AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Range("B1"), Unique:=True
'?
Columns("A:A").Delete
Cells.Select
Selection.Sort _
Key1:=Range("A2"), Order1:=xlAscending, _
Header:=xlYes, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
lMaxSupp = Cells(Rows.Count, 1).End(xlUp).Row
For suppno = 2 To lMaxSupp
Windows(thisWB).Activate
supName = Sheets("tempsheet").Range("A" & suppno)
If supName <> "" Then
Workbooks.Add
ActiveWorkbook.SaveAs supName
newWB = ActiveWorkbook.Name
Windows(thisWB).Activate
Sheets("Main").Select
Cells.Select
If ActiveSheet.AutoFilterMode = False Then
Selection.AutoFilter
End If
Selection.AutoFilter Field:=2, Criteria1:="=" & supName, _
Operator:=xlAnd, Criteria2:="<>"
LastRow = Cells(Rows.Count, 2).End(xlUp).Row
'Copy from TempSheet
Rows("1:" & LastRow).Copy
'Paste in newWB in TempSheet
Windows(newWB).Activate
ActiveSheet.Paste
'Save and Close newWB
ActiveWorkbook.Save
ActiveWorkbook.Close
End If
Next
'Delete TempSheet
Sheets("tempsheet").Delete
Sheets("Main").Select
If ActiveSheet.AutoFilterMode Then
Cells.Select
ActiveSheet.ShowAllData
End If
End Sub
Thanks for the help!
I am guessing this code does not achieve the effect you seek and you do not know where to start fixing it.
You are attempting too much in one go when you do not really know what you are doing.
I suggest you start by writing simple macros each of which achieves one step of your total requirement or adds one step to a previous macro. If you run into difficulties with one of these macros, you can post it with an explanation of what it does and what you want it to do. Questions with macros that isolate a single problem get answered very quickly. I would not know where to start debugging your current macro.
You have an AutoFilter but I cannot see how that selects the records of a patron with an overdue record. I think that is your first problem: how does the macro know which patron’s records are to be output? Could this be supName? Where has this come from?
Can you write a macro that creates an empty workbook and saves it with the desired name? Call that Macro1.
Write Macro2 by updating Macro1, to rename Sheet1 as “Overdue” or something more meaningful and then delete the other worksheets.
Can you write a macro that uses AutoFilter to select the required records? Write this as new macro Macro3.
Merge Macro2 and Macro3 and try copying the rows selected by AutoFilter to the new workbook. The statement SourceRange.Copy Destination:=FirstDestCell is likely to be easier to use than Copy and Paste.
I hope you can see why little macros which expand your knowledge one step at a time will be an easier path to your objective than trying to debug your current code.
I am trying design a macro in excel 2007. Here is what I need it to do:
When I enter an ID into a specific cell and run the macro, it will search for that ID in column A of a different workbook and autofilter. Then I need it to copy that data and paste it into the first workbook. My code is working, however when it is pasting a ton of extra rows beneath my data. How can I make it only copy and paste data and not empty rows? Here is my code:
Sub Medications()
'
' Medications Macro
'
' Keyboard Shortcut: Ctrl+m
'
Range("B1").Select
Workbooks.Open Filename:= _
"I:\Pharmacy\MTMP\2013\Master Lists\CMR Medication List.xlsx"
Range("A1").Select
ActiveCell.FormulaR1C1 = "Member ID"
Range("A1").Select
Selection.AutoFilter
ActiveSheet.Range(Selection, ActiveCell.SpecialCells(xlLastCell)).AutoFilter Field:=1, Criteria1:=Workbooks("Standardized Format Spreadsheet.xlsm").Worksheets("Demographics").Range("B1").Value
Cells.Select
Selection.Copy
Windows("Standardized Format Spreadsheet.xlsm").Activate
Sheets("Detailed Medication List").Select
Range("A1").Select
ActiveSheet.Paste
Windows("CMR Medication List.xlsx").Activate
Application.CutCopyMode = False
Application.DisplayAlerts = False
ActiveWorkbook.Close
Application.DisplayAlerts = True
Sheets("Demographics").Select
End Sub
It is always best to avoid selecting items whenever possible. You can use set a workbook to an object and access it through that.
The reason you are getting extra cells when you copy/paste is because you are selecting every cell and then copying. I suggest using only the used range so you don't pick up any extra cells.
Sub Medications()
Dim CMR_Wkbk As Workbook
Dim SFS_Wkbk As Workbook
Set SFS_Wkbk = Workbooks("Standardized Format Spreadsheet")
Set CMR_Wkbk = Workbooks.Open("I:\Pharmacy\MTMP\2013\Master Lists\CMR Medication List.xlsx")
Range("A1").Value = "Member ID"
ActiveSheet.UsedRange.AutoFilter Field:=1, Criteria1:=SFS_Wkbk.Sheets("Demographics").Range("B1").Value
ActiveSheet.UsedRange.Copy Destination:=SFS_Wkbk.Sheets("Detailed Medication List").Range("A1")
Application.DisplayAlerts = False
CMR_Wkbk.Close
Application.DisplayAlerts = True
Sheets("Demographics").Select
End Sub
Cells.Select
Selection.Copy
Cells.Select is selecting the entire content of the worksheet. I don't know, obviously, what you sheet looks like, but try selecting only the CurrentRegion - the equivalent of what is highlighted when you click in a cell and press Ctrl-A:
ActiveCell.CurrentRegion.Copy