I hope someone can help me, as I know that the macro I am trying to create would save about 30 minutes' work if it comes off.
Once a month I download a financial transactions report; the search variables I need to use are in column C. The number of rows for each search variable changes from month to month. I need to search for all rows containing a given variable (e.g. VDEN, VDEM VDEF; these are exact search terms), copy all rows containing the variable and paste them into a one of five workbooks, each with several worksheets in it.
I have some code to do this with one term and one worksheet location, but I don't know how to loop it so that it goes back for a new variable and starts the whole process all over again.
This is what I have already:
Sub Macro2()
Workbooks.Open Filename:="C:\Users\jo\Desktop\Month End.xlsx"
Columns("A:L").Select
Selection.EntireColumn.Hidden = False
Application.DisplayAlerts = False
Cells.Find("Total:").Rows(1).EntireRow.Delete
Application.DisplayAlerts = True
Dim lastrow As Long
lastrow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
With ActiveSheet.Range("a1:l" & lastrow)
.AutoFilter Field:=3, Criteria1:="VDEN"
.Offset(1, 0).Copy
End With
Workbooks.Open Filename:="X:\admin\Finance\2016-17\Transaction Lists\Sample Transactions 2016-17.xlsx"
Windows("Month End.xlsx").Activate
Windows("Sample Transactions 2016-17.xlsx").Activate
Sheets("Pre-Sessional").Select
Columns("A:L").Select
Selection.EntireColumn.Hidden = False
Windows("Sample Transactions 2016-17.xlsx").Activate
Worksheets("Pre-Sessional").Activate
Range("A" & Rows.Count).End(xlUp).Offset(1).Select
ActiveSheet.Paste
Range("D:D,F:F,G:G,H:H,K:K").Select
Selection.EntireColumn.Hidden = True
Windows("Month End.xlsx").Activate
ActiveSheet.ShowAllData
End Sub
Can anybody help?
Many thanks
Look at the OR clause in your filter. I'd suggest recording doing a multiple selection filter, like this And Or Criteria about 2/3 down. Or use a for next loop on an array. Like so Looping Array
Related
i have created this excel sheet to help me out with stock analysis. the main macro within the sheet scrubs yahoo finance and market watch for specific information, throws it into different sheets, copies and pastes it into a summary sheet and then moves on to the next ticker. The macro only works up until 5 tickers. I dont know if it is because my code is not optimized as much as it should be or if there is something else that i can do to allow me to run more than 5 tickers at a time. Any advice would help :)
thank you and i appreciate your time
here is my code for the macro
Sub fundamentals()
'This checks the tickers that we enter at the top of the sheet
Call TurnOffStuff
For i = 2 To Sheets(1).Cells(1, 1).End(xlToRight).column
'This will assign one of the tickers to the variable to be inserted into the url
ticker = Sheets(1).Cells(1, i)
qurl = "https://finance.yahoo.com/quote/" & ticker & "/?p=" & ticker & ""
'This gets the data from yahoofinance's summary page and puts it in sheet 5
Sheets(5).Select
Sheets(5).Cells.Clear
With ActiveSheet.QueryTables.Add(Connection:="URL;" & qurl, Destination:=Sheets(5).range("A2"))
.BackgroundQuery = True
.Refresh BackgroundQuery:=False
End With
'This takes the data that we got off of the url above and copy & paste it to
'main sheet we want our data to be in
Sheets(5).range("B2:B18").Copy
Sheets(1).Select
Cells(2, i).Select
ActiveSheet.Paste
CutCopyMode = False
qurl = "https://finance.yahoo.com/quote/" & ticker & "/key-statistics?p=" & ticker & ""
'This gets the data from yahoofinance's key statistics page and puts it in sheet 2
Sheets(2).Select
Sheets(2).Cells.Clear
With ActiveSheet.QueryTables.Add(Connection:="URL;" & qurl, Destination:=Sheets(2).range("A2"))
.BackgroundQuery = True
.Refresh BackgroundQuery:=False
End With
'This takes the data that we got off of the url above and copy & paste it to
'main sheet we want our data to be in
Sheets(2).range("B20:B78").Copy
Sheets(1).Select
Cells(22, i).Select
ActiveSheet.Paste
CutCopyMode = False
qurl = "https://finance.yahoo.com/quote/" & ticker & "/analysis?p=" & ticker & ""
'This gets the data from yahoofinance's analysis page and puts it in sheet 3
Sheets(3).Select
Sheets(3).Cells.Clear
With ActiveSheet.QueryTables.Add(Connection:="URL;" & qurl, Destination:=Sheets(3).range("A2"))
.BackgroundQuery = True
.Refresh BackgroundQuery:=False
End With
'This takes the data that we got off of the url above and copy & paste it to
'main sheet we want our data to be in
Sheets(3).range("B20:B60").Copy
Sheets(1).Select
Cells(94, i).Select
ActiveSheet.Paste
CutCopyMode = False
Sheets(3).range("C20:C60").Copy
Sheets(1).Select
Cells(136, i).Select
ActiveSheet.Paste
CutCopyMode = False
Sheets(3).range("D20:D60").Copy
Sheets(1).Select
Cells(178, i).Select
ActiveSheet.Paste
CutCopyMode = False
Sheets(3).range("E20:E60").Copy
Sheets(1).Select
Cells(220, i).Select
ActiveSheet.Paste
CutCopyMode = False
qurl = "https://www.marketwatch.com/investing/stock/" & ticker & "/analystestimates?mod=mw_quote_tab"
'This gets the data from market watches anaylst estimate page and puts it in sheet 4
Sheets(4).Select
Sheets(4).Cells.Clear
With ActiveSheet.QueryTables.Add(Connection:="URL;" & qurl, Destination:=Sheets(4).range("A2"))
.BackgroundQuery = True
.Refresh BackgroundQuery:=False
End With
'This takes the data that we got off of the url above and copy & paste it to
'main sheet we want our data to be in
Sheets(4).range("B17:B79").Copy
Sheets(1).Select
Cells(264, i).Select
ActiveSheet.Paste
CutCopyMode = False
Sheets(4).range("C35:C63").Copy
Sheets(1).Select
Cells(327, i).Select
ActiveSheet.Paste
CutCopyMode = False
Sheets(4).range("D35:D63").Copy
Sheets(1).Select
Cells(356, i).Select
ActiveSheet.Paste
CutCopyMode = False
Sheets(4).range("E35:E43").Copy
Sheets(1).Select
Cells(385, i).Select
ActiveSheet.Paste
CutCopyMode = False
Next i
Call TurnOnStuff
Sheets("All Ticker Analysis").Activate
ActiveSheet.Cells(1, 1).Select
End Sub
Sub TurnOffStuff()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False
End Sub
Sub TurnOnStuff()
Application.Calculation = xlCalcualtionAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
I agree with #Pᴇʜ in avoiding use of Select in Excel. R could also be a good alternative using 'quantmod'. However, lets try and answer your question. Since I cannot see the sheet I cannot know if there is anything which could be inhibiting you from not being able to pull all tickers. One thing to try is to enter the macro and repeatedly press F8 to step through it. Watch the steps and check to see how many iterations of (i) your macro is performing. It may be stopping early. If you have nothing to the right of the columns in Sheets(1). Try using this following code:
For i = 2 to Sheets(1).Cells(1, Columns.Count).End(xlToLeft).Column
This should help ensure you are getting the right most column in the sheet, incase there are any spaces. And if there is no data it is not going off towards Excel's column limit.
Also, the ranges of B are not dynamic. What if the data is longer or shorter than expected?
Try using variables to find the range size, and check the range size by using the same .End(xlToLeft/ToRight/Up/Down) functionality shown above.
I think your sheet should be fully capable of doing this, and I don't think it is because the sheet is not "optimized" haha. Excel is normally far from optimized. I think your problem lies in the macro ending early because it isn't going through the full loop. Again, step through it using F8 and see if you can't find where the logical misstep is. Also, to speed it up you could turn screen updating off. Do this using the following line of code:
Application.ScreenUpdating = False 'Use this at the very beginning of the macro
Last thing, some of your sheets may be fried. I don't know the technical term for this, but it can occur in poorly constructed macros, where the sheet doesn't appear to change, but actually can encompass all rows or all columns by mistake and really slow down a program. Check the slider bars on each sheet and see what row and column you slide to when you move the bar all the way to the bottom. If it brings to the millions of rows or columns like ZXX, then you know the sheet is bad and sucking memory in Excel. The only solution is to create a new sheet from scratch. This likely happened to your sheets based on the For loop I corrected earlier. If you have ever run the sheet without a ticker or with just 1 ticker, you likely blew out your columns and will need to reconstruct this sheet. This should also help improve the time issues you are facing. And when I say reconstruct the sheet that does not mean you need to redo the entire file! Just create a new sheet, populate it the way you like, and then delete your old one and update the code to match the new sheet number.
I have an Excel sheet which looks at performance figures for a rolling 5 week period. I created a macro which copies the data from week 4 to week 5 and repeats for each work sheet before leaving week 1 empty so I can paste in the most recent data.
The macro is slow and seems to get slower every week. To try to make it faster I put in code to clear the existing contents before pasting in the new data. This worked at first, but it has slowed again.
This is the code for the first two sheets to be copied. It does the same for the rest of the sheets but the code is the same.
Sub Move_data() ' Copies all data across to advance sheet by one week.
Application.ScreenUpdating = False
Sheets("Week 5").Select ' Clears current entry from week 5
Range("A1:S161").Select
Application.CutCopyMode = False
Selection.ClearContents
Sheets("Week 4").Select 'Selects data to copy from week 4
Range("A1:S161").Select
Selection.Copy
Sheets("Week 5").Select 'Pastes data to week 5
Range("A1").Select
ActiveSheet.Paste
Sheets("Week 4").Select 'Clears data from week 4
Application.CutCopyMode = False
Selection.ClearContents
Sheets("Week 3").Select 'Selects data to copy from week 3
Range("A1:S161").Select
Selection.Copy
Sheets("Week 4").Select 'Pastes data to week 4
Range("A1").Select
ActiveSheet.Paste
Having looked at various articles I think that part of the problem lies in using ".Select" so frequently.
I tried to replace these two lines:
Range("A1:S161").Select
Selection.Copy
with
Range("AR:S161").Copy
It didn't seem to have much impact on the time it takes for the macro to run.
How could this code work more efficiently?
If you are only interested in moving the values from one sheet to another then Value Transfer is ideal solution since it's more efficient than copy/paste. However, if you also need to copy formulas from one sheet to the next then you will need to switch to Copy/Paste.
Sub Mover()
Dim wb As Workbook: Set wb = ThisWorkbook
Dim i As Long
For i = 5 To 1 Step -1
wb.Sheets("Week " & i).Range("A1:S161").ClearContents
If i <> 1 Then
wb.Sheets("Week " & i - 1).Range("A1:S161").Copy
wb.Sheets("Week " & i).Range("A1").PasteSpecial xlPasteAll
End If
Next i
End Sub
Try this:
Sub Move_data() ' Copies all data across to advance sheet by one week.
Const RNG As String = "A1:S161"
Dim n As Long
For n = 5 to 2 step - 1
Sheets("Weeek " & n).Range(RNG).Value = Sheets("Weeek " & (n-1)).Range(RNG).Value
Next n
End Sub
Assigning values directly is often faster.
I have a membership roster that I am keeping for a chapter in a club. Rather than delete members who are no longer in the chapter, I decided to try and create a macro that looks at the Chapter Roster Master sheet in column A (Still in Chapter?) for a "yes" value and then transfers the all the rows with the yes value to another sheet called "Chapter Roster Actual".
The macro works but I would like to only transfer columns B through O and not include Column A.
I realize the one line actually tells the macro to copy the "entire row" and I have tried to have it copy only a range but in doing that, it disregards the request to only copy rows where column A has a 'yes' value. I have the range line in there as well so you could see what I tried.
I also need to figure out how to not append the rows to previously copied rows. So, I guess it should clear the rows previously populated and then write the new rows.
Here is the macro:
Sub ActualRoster()
Dim myRow, LastRow
myworksheet = "Chapter Roster Master"
LastRow = Sheets(myworksheet).Range("A" & Rows.Count).End(xlUp).Row
For myRow = 3 To LastRow
If Sheets(myworksheet).Cells(myRow, "A").Value = "Yes" Then
Sheets(myworksheet).Cells(myRow, "A").EntireRow.Copy Destination:=Sheets("Chapter Roster Actual").Range("A" & Rows.Count).End(xlUp).Offset(1)
'Sheets(myworksheet).Range("B3:O32").Copy Destination:=Sheets("Chapter Roster Actual").Range("A3:O32").End(xlUp).Offset(1)*
End If
Next myRow
End Sub
In what you tried, you are copying all the rows starting from 3 right upto 32 even if only current row is 'Yes'
The following works fine
Sub ActualRoster()
Dim myRow, LastRow
myworksheet = "Chapter Roster Master"
Sheets("Chapter Roster Actual").Range("A3").CurrentRegion.Offset(2,0).ClearContents
Sheets(myworksheet).Activate
LastRow = Sheets(myworksheet).Range("A" & Rows.Count).End(xlUp).Row
For myRow = 3 To LastRow
If Sheets(myworksheet).Cells(myRow, "A").Value = "Yes" Then
Sheets(myworksheet).Range(Cells(myRow,"B"),Cells(myRow,"O")).Copy Destination:=Sheets("Chapter Roster Actual").Range("A" & Rows.Count).End(xlUp).Offset(1)
End If
Next myRow
End Sub
As suggested in a comment, you can also try filter the Master data and copy all required data in one shot. As a starting point, record a macro and you will get a feel of how that can be done. Come back to refine recorded code.
You can use below code If you want to try using the filter instead of iterating over all the records. You can check which works best for you and use.
Sub ActualRoster()
Dim myRow, LastRow
myworksheet = "Chapter Roster Master"
LastRow = Sheets(myworksheet).Range("A" & Rows.Count).End(xlUp).Row
Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.AutoFilter
Range("A2").Select
ActiveSheet.Range("A2", Range("A2").End(xlToRight)).AutoFilter Field:=1, Criteria1:="Yes"
Range("A2").End(xlToLeft).Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy Destination:=Sheets("Chapter Roster Actual").Range("A" & Rows.Count).End(xlUp).Offset(1)
End Sub
Note: There might be more optimized code for this scenario too
Tip: You can learn how macro works by opening the VBA along with Excel (in side by side mode), record the macro and observe the code generated.
I am trying to delete entire rows with duplicate values. If the values in column "E" are the same in two rows, I want to delete all row with that value that is duplicated.
The other fields might be or not duplicates of that row and there might be up to ten duplicates and the total number of rows is large ( #rows >4000). This is just one part of a large macro, so I cannot use excel functions. This is what I have so far for deleting rows:
Sub AAAAH()
Application.ScreenUpdating = False
Dim i As Single
Dim j As Single
BottomLineRelease = Sheets("Hours Of Interest").Range("E" & Rows.Count).End(xlUp).Row + 1
rowcount = Sheets("Hours Of Interest").Range("E2:E" & BottomLineRelease).Rows.Count
For i = 2 To Sheets("Hours Of Interest").Cells(Rows.Count, "E").End(xlUp).Row
If Sheets("Hours Of Interest").Range("E" & i) = Sheets("Hours Of Interest").Range("E" & i - 1) Then
j = i - 1
Rows(j).Select
Selection.delete Shift:=xlUp
End If
Next i
Application.ScreenUpdating = True
End Sub
This not only crashes Excel, but the "Selection.delete Shift: =xlup" will not allow the "delete" to stay capitalized. Every time I click away, it goes back to lower case.
Does anyone know a faster or at least functional way to delete these duplicate rows in VBA?
Selection (=Application.Selection) is declared only as Object because it can take various objects (a range, a shape object, a chart etc. etc.). Therefore the intellisense doesn't work as well, it is only determined during execution if .Delete is a valid method.
Try
Sheets("Hours Of Interest").Rows(j).Delete Shift:=xlUp
If you use Sheets(...).Range in your code, you should never get lazy and never use Range or Rows or Cells without that explicit reference, you might be deleting on a different worksheet.
Furthermore, if you delete rows from the top down, every delete changes the row numbers of the following lines.
So you should delete backwars with
for i = [..maximum..] to 0 step -1
You don't need a loop to isolate unique values. You can filter column E for unique values, copy those to a new sheet, and delete the old sheet.
lastRow = Range("A1000000").End(xlUp).Row
Range("A1:H" & lastRow).AdvancedFilter Action:=xlFilterInPlace, _
CriteriaRange:=Range("E1:E" & lastRow), Unique:=True
Cells.Copy
Sheets.Add
ActiveSheet.Paste
Application.DisplayAlerts = False
Sheets("oldSheet").Delete
Application.DisplayAlerts = True
This is way faster than a loop, if memory serves.
I have the following macro defined which inserts rows into a sheet. After the rows are inserted at specified start addresses, the various ranges are then converted into Tables. My initial thoughts are that the issue lies with the use of xlDown - since this is the place in code where rows are inserted.
At present I have 7 such ranges, however the issue is that first three always have an additional row inserted - this was previously working with no issues, so the fact that its misbehaving is a puzzle to me.
The remaining ranges are correct. The tableStartAdress refers to named ranges whose values correspond to the first cell below the green title, ie A4, A12 etc. rowsToInsert for this example is always 38.
Sub InsertTableRows(tableStartAdress As String, rowsToInsert As Integer)
Dim i As Integer
Dim rowToCopy As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.DisplayAlerts = False
Range(tableStartAdress).Offset(1, 0).Rows.Copy
rowToCopy = Range(tableStartAdress).Offset(1, 0).row & ":" & _
Range(tableStartAdress).Offset(1, 0).row
Rows(rowToCopy).Select
Selection.Copy
Range(tableStartAdress).Offset(1, 0).Select
ActiveCell.Resize(rowsToInsert, 1).Select
Selection.Insert Shift:=xlDown
Application.CutCopyMode = False
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
The following pictures depict what I mean.
Before:
.
Once data is populated the first three range/tables have an extra row
, ,
Whilst the remainder are correct
I'd suggest simplifying your code to start. (Might help you track down were things are going wrong.) Since you don't need to select a range before you do something with it....
rowToCopy = Range(tableStartAdress).Offset(1, 0).Row & _
":" & Range(tableStartAdress).Offset(1, 0).Row
Rows(rowToCopy).Select
Selection.Copy
Range(tableStartAdress).Offset(1, 0).Select
ActiveCell.Resize(rowsToInsert, 1).Select
Selection.Insert Shift:=xlDown
is the same as...
Range(tableStartAdress).Offset(1, 0).EntireRow.Copy
Range(tableStartAdress).Offset(1, 0).Resize(rowsToInsert, 1).Insert Shift:=xlDown
which is much easier to look at. A couple thoughts: First, are you sure that tableStartAddress is really always a single cell (and the correct cell)? Are you sure that rowsToInsert is always 38? Beyond that, your code as it's currently written is copying an entire row and inserting it into a range that's theoretically 38 rows by 1 column. I would recommend rewriting this so you first insert however many rows you want, then fill the 38 x 1 range with the data that belongs there.