Excel VBA Macro: Autofill a list in a Weekday frequency - vba

With this macro I am able to insert a new row at the bottom of a daily time-series data. The macro performs well, but even though I specified to fill the series with Weekdays and avoid weekends, it still not do so and fills with all the days of the week.
Any suggestions on what I might be missing?
Please also see the screenshot for a better understanding.
Thank a lot.
Sub Weekday_Data_Update()
Range("A2").Select
Selection.End(xlDown).Select
ActiveCell.Offset(-1, 0).Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Resize(3).Select
Selection.DataSeries Rowcol:=xlColumns, Type:=xlAutoFill, Date:=xlWeekday, _
Trend:=False
End sub
Example of how the macro is filling the dates wrongly

I am confused by all your up, down, across movement. To simply extend dates across a range only using weekdays would have syntax such as follows:
Option Explicit
Public Sub Test()
With Worksheets("Sheet1")
.Range("A2").AutoFill Destination:=.Range("A2:A7"), Type:=xlFillWeekdays
End With
End Sub
You can construct a fill to last used cell as follows:
.Range("A2").AutoFill Destination:=.Range(.Cells(2, "A"), .Cells(.Cells.SpecialCells(xlLastCell).Row, "A")), Type:=xlFillWeekdays

Just to break it down, the below code will print ONLY the Weekdays
Sub Weekday_Data_Update()
Dim startRange As Range
Dim stopRange As Range
'Specify the cell where the date starts
Set startRange = Sheets("Sheet1").Range("A2")
'Specify the cell until which you want weekdays to be displayed
Set stopRange = Sheets("Sheet1").Range("A2:A6")
startRange.Select
Selection.AutoFill Destination:=stopRange, Type:=xlFillWeekdays
End Sub
P.S: Not sure why you many range selections in your code.

According to MSDN, Date:=xlWeekday is only applicable when you use Type:=xlChronological
So, try
Selection.DataSeries Rowcol:=xlColumns, Type:=xlChronological, Date:=xlWeekday, _
Trend:=False
Refer to MSDN help for further details

Related

VBA not updating Excel rows referring to other sheets in same workbook when sorting rows alphabetically

I'm having problems, Excel is not updating rows referring to other sheets in same workbook when ordering rows alphabetically.
I have a userform in which there's a button insertCM with this code:
Private Sub insertButton_Click()
ActiveCell.EntireRow.Select
Selection.Insert Shift:=xltoDown
Range("A9:AK9").Copy
Range("A8:AK8").Select
Selection.PasteSpecial Paste:=xlPasteFormulas
Selection.PasteSpecial Paste:=xlPasteFormats
Range("C10").Copy
Range("C8:C9").Select
Selection.PasteSpecial Paste:=xlPasteFormulas
Range("H9:AK9").Copy
Range("H8:AK8").Select
Selection.PasteSpecial Paste:=xlPasteAll
nomCM = Empty
CXinitial = Empty
resteCX = Empty
CCselect = Empty
C4initial = Empty
resteC4 = Empty
compteurCT = Empty
Range("A8").Activate
ActiveCell.RowHeight = 18.6
For i = 2 To ThisWorkbook.Sheets.Count
With Sheets(i).Select
emptyRow = Range("A9").End(xlDown).Offset(0, 2).Row
Range("A9:AL" & emptyRow).Sort _
Key1:=Range("A9"), Order1:=xlAscending
Set SearchRange = Range("A8", Range("A200").End(xlUp))
Set FindRow = SearchRange.Find(nomCM, LookIn:=xlValues, LookAt:=xlWhole)
Range("A" & FindRow.Row).Select
ActiveCell.EntireRow.Activate
End With
Next i
Sheet2.Select
End
End Sub
The userform is used for inserting new clients in several sheets at the same time. Textbox inserts Name, Cost Center, etc., in a blank row and insertButton inserts a new row leaving data inserted in row 8 to go to row 9. After that the code puts all rows alphabetical order so the new client now in row 9 goes to the new one, and cells containing formulas change row numbers.
However some of the sheets have cells containing references to other sheets' cells in the same row. So imagine:
I insert client name "LORUM" "Cost Center 4" and it puts him in row 9 so formula is:
=$C9-COUNTIF($E9:$P9;"CT")+'Sheet5'!$D9
...but when it changes his row to the final one, formula row is:
=$C18-COUNTIF($E18:$P18;"CT")+'Sheet5'!$D9
It does not change row when referring to other sheets.
Any ideas?
It's looks like you've made a good effort, but there are still numerous problems with your code (beside the one line), and I can guarantee that a combination of these issues are preventing your intended outcome.
I can't fix it completely because there are so many bugs that I'm not clear on what you're trying to do, but hopefully this will get you started on the right track...
xlToDown is not a valid reference. You probably mean xlDown
you have a number of undeclared variables and objects, like: i, emptyRow, SearchRange, FindRow, nomCM
you have things (objects?) "set to nothing" that aren't declared or used anywhere: CXinitial, resteCX, CCselect, C4initial, resteC4, compteurCT
your Find statement is looking for nomCM which is empty (and never set), so the Find statement will never find anything.
You should put Option Explicit at the top of every module (especially when learning or troubleshooting). This will prevent issues like the ones above by "forcing" you to properly declare & handle all of your variables, objects, properties, etc.
Near the end, you refer to Sheet2.Select as if Sheet2 is a declared object, instead of using Sheets("Sheet2").Select. I'm not sure why you're selecting the sheet at the very end anyhow.
You have an With..End statement that is doing absolutely nothing since you don't reference it with a . dot anywhere: With Sheets(i).Select .. End With, and also Select isn't used like that.
A mystery End near the end for some reason.
Also, you're unnecessarily doubling up commands like:
ActiveCell.EntireRow.Select
Selection.Insert Shift:=xlDown
..instead of:
ActiveCell.EntireRow.Insert Shift:=xlDown
and another example, all this:
Range("A9:AK9").Copy
Range("A8:AK8").Select
Selection.PasteSpecial Paste:=xlPasteFormulas
Selection.PasteSpecial Paste:=xlPasteFormats
Range("C10").Copy
Range("C8:C9").Select
Selection.PasteSpecial Paste:=xlPasteFormulas
Range("H9:AK9").Copy
Range("H8:AK8").Select
Selection.PasteSpecial Paste:=xlPasteAll
...instead of:
Range("A9:AK9").Copy
Range("A8:AK8").PasteSpecial xlPasteValuesAndNumberFormats
Range("C10").Copy
Range("C8:C9").PasteSpecial Paste:=xlPasteFormulas
Range("H9:AK9").Copy Range("H8:AK8")
All of this would be more clear by Googling the documentation for each command you're unfamiliar with, such as:
Range.Copy Method (Excel)
Range.PasteSpecial Method (Excel)
XlPasteType Enumeration (Excel)
All the ActiveCell and ThisWorkbook references are troublesome but again, I'm not sure what to do with them since I don't know your workbook.
Indentation (and general organization) are very important as well. It may not change the way that the code runs, but it will help you (and others) track down existing & potential issues more easily.
Here is your code cleaned up as best as I could:
Option Explicit 'this line goes at the very top of the module
Private Sub insertButton_Click()
Dim i As Long, emptyRow As Long, SearchRange As Range, FindRow As Range, nomCM
nomCM = Empty
ActiveCell.EntireRow.Insert Shift:=xlDown
Range("A9:AK9").Copy
Range("A8:AK8").PasteSpecial xlPasteValuesAndNumberFormats
Range("C10").Copy
Range("C8:C9").PasteSpecial Paste:=xlPasteFormulas
Range("H9:AK9").Copy Range("H8:AK8")
Range("A8").RowHeight = 18.6
For i = 2 To ThisWorkbook.Sheets.Count
With Sheets(i)
emptyRow = .Range("A9").End(xlDown).Offset(0, 2).Row
.Range("A9:AL" & emptyRow).Sort Key1:=.Range("A9"), Order1:=xlAscending
Set SearchRange = .Range("A8", .Range("A200").End(xlUp))
Set FindRow = SearchRange.Find(nomCM, LookIn:=xlValues, LookAt:=xlWhole)
.Range("A" & FindRow.Row).Select
ActiveCell.EntireRow.Activate
End With
Next i
Sheets("Sheet2").Select
End Sub
as per my test, sorting actually doesn't change other sheet direct references
so you may want to use OFFSET to keep referencing the actual current row index
instead of:
=$C9-COUNTIF($E9:$P9;"CT")+'Sheet5'!$D9
use
=$C9-COUNTIF($E9:$P9;"CT")+ OFFSET('Sheet5'!$D1,ROW()-1,0)
I found a solution:
=INDIRECT(ADDRESS(ROW();4;3;1;"Sheet5"))
Where Row() will always refer to the actual cell's row.
Hope it will help you!

Data Validation Dynamic Range Moves Range Instead of Expanding Range

In Excel, I have a Data Validated range using the OFFSET() function that I'm hoping to dynamically add information to that I can then select in a drop down list. I have a VBA macro that I'm adding information to this list from and instead of expanding the list from $L$10:$L$230 to $L$10:$L$231, it shifts my list down to $L$11:$L$230. What am I doing incorrectly in my Named Range or Data Validation to not make this work? Or does it have something with using VBA to add to the range that causes it to work incorrectly?
"Rooms" in my Name Manager Refers To:
=OFFSET(Sheet1!$L$10,0,0,COUNTA(Sheet1!$L:$L),1)
My Data Validation Drop Down Souce:
=Rooms
My "insert" Macro to add to the list:
Sub insert()
'
' insert Macro
'
'
Range("A2:E2").Select
Selection.Copy
Sheets("Sheet1").Select
Range("L10:P10").Select
Selection.insert Shift:=xlDown
Sheets("INSERT NEW ROOM").Select
ActiveWindow.SmallScroll Down:=-18
Range("A2").Select
End Sub
I also have a "Sort" VBA included in my Sheet1 for every time a new instance is added from the "INSERT NEW ROOM" tab.
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Not Intersect(Target, Range("L9:L500")) Is Nothing Then
Range("L9").Sort Key1:=Range("L10"), _
Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End Sub
This happens because your insert macro changes the range your named range formula refers to, just like it would any normal formula.
The formula has a reference to cell $L$10. When you execute
Range("L10:P10").Insert Shift:=xlDown
any formula, including the named range formula, that referes to a cell on or below row 10 will be updated to refer to a cell one row down (ie $L$11 in this case)
You can fix this by changing your named range formula to this
=OFFSET(Sheet1!$L$1,9,0,COUNTA(Sheet1!$L:$L),1)
Notice it now refers to cell $L$1 so is not affected by the insert.
Note:
You insert macro could do with some work
Try this instead
Sub InsertRooms() ' renamed to avoid using a built in function name
Range("A2:E2").Copy
Worksheets("Sheet1").Range("L10:P10").insert Shift:=xlDown
Application.CutCopyMode = False
End Sub

Multiple data sets, input into separate workbook, output each dataset into own field

I am very new, never done programming before and never used a forum before. I have read a lot of other posts to get as far as I have done in Excel to try and get it to perform as I require.
Basically I have a number of data sets, each with 4 variables, each set needs to be copied into appropriate fields on another worksheet, then the 2 outputs from this, recorded back onto the first sheet in 2 separate columns for each data set.
I have got the macro to do nearly all of it however it pastes only the last set of data outputs in the cells not each individual set.
Unfortunately I appear not to be able to add screen shots.
Currently my macro text is:
Sub macro1()
Dim rCell As Range
Dim rRng As Range
Set rRng = Sheet1.Range("C2:C6")
For Each rCell In rRng.Cells
rCell.Copy
Sheets("Sheet2").Select
Range("C2").Select
Sheets("Sheet2").Paste
Next rCell
Dim rCell2 As Range
Dim rRng2 As Range
Set rRng2 = Sheet1.Range("D2:D6")
For Each rCell2 In rRng2.Cells
rCell2.Copy
Sheets("Sheet2").Select
Range("D2").Select
Sheets("Sheet2").Paste
Range("C8").Select
Selection.Copy
Sheets("Sheet1").Select
Range("J2:J6").PasteSpecial Paste:=xlPasteValues
Next rCell2
Dim rCell3 As Range
Dim rRng3 As Range
Set rRng3 = Sheet1.Range("E2:E6")
For Each rCell3 In rRng3.Cells
rCell3.Copy
Sheets("Sheet2").Select
Range("E2").Select
Sheets("Sheet2").Paste
Next rCell3
Dim rCell4 As Range
Dim rRng4 As Range
Set rRng4 = Sheet1.Range("F2:F6")
For Each rCell4 In rRng4.Cells
rCell4.Copy
Sheets("Sheet2").Select
Range("F2").Select
Sheets("Sheet2").Paste
Range("D8").Select
Selection.Copy
Sheets("Sheet1").Select
Range("K2:K6").PasteSpecial Paste:=xlPasteValues
Next rCell4
End Sub
Apologies for the repetition, I hope someone can help.
Also if there are any good books that people can rate to learn basic macro and programming language that would be great.
You are using Range variables which is good but you are then using Select which should be avoided.
If you want to copy from Sheets("Sheet1").Range("C2:C6") and paste into Sheets("Sheet2").Range("C2:C6"), you can do this in one line of code. You do not need to loop through the cells for this:
Sheets("Sheet1").Range("C2:C6").Copy Sheets("Sheet2").Range("C2")
Your code as posted was looping through the cells but was always pasting into the same cell.
You can copy a larger block of code and it looks like your code is trying to copy cells C2:F6. Normally you can do that with one line:
Sheets("Sheet1").Range("C2:F6").Copy Sheets("Sheet2").Range("C2")
But maybe the paste special causes the values in columns D & E to get changed?
The PasteSpecial method requires two lines of code but this seems ok in your code. These lines of code copies one value and pastes it into five cells:
Sheets("Sheet2").Range("C8").Copy
Sheets("Sheet1").Range("J2:J6").PasteSpecial Paste:=xlPasteValues
You can simplify your code to:
Sheets("Sheet1").Range("C2:C6").Copy Sheets("Sheet2").Range("C2")
Sheets("Sheet1").Range("D2:D6").Copy Sheets("Sheet2").Range("D2")
Sheets("Sheet2").Range("C8").Copy
Sheets("Sheet1").Range("J2:J6").PasteSpecial Paste:=xlPasteValues
Sheets("Sheet1").Range("E2:E6").Copy Sheets("Sheet2").Range("E2")
Sheets("Sheet1").Range("F2:F6").Copy Sheets("Sheet2").Range("F2")
Sheets("Sheet2").Range("D8").Copy
Sheets("Sheet1").Range("K2:K6").PasteSpecial Paste:=xlPasteValues
And maybe copy larger blocks of cells to reduce the number of copy operations?
Sheets("Sheet1").Range("C2:D6").Copy Sheets("Sheet2").Range("C2")
Sheets("Sheet2").Range("C8").Copy
Sheets("Sheet1").Range("J2:J6").PasteSpecial Paste:=xlPasteValues
Sheets("Sheet1").Range("E2:F6").Copy Sheets("Sheet2").Range("E2")
Sheets("Sheet2").Range("D8").Copy
Sheets("Sheet1").Range("K2:K6").PasteSpecial Paste:=xlPasteValues

Copy formula from a specific sheet and cell and drag it down until specific column last row

So far I have this code below; counting last cell is working fine but is copy/pasting the wrong data to wrong sheet. Should copy data and use the formula from Sheet "Parsing" cell B2, and its using the main sheet where is the VBA. Looks lile what is missing is to execute the copy/select to "parsing" sheet, but didnt manage to do it.
Sub drag_formula_original()
Dim myLastRow As Long
With Worksheets("Parsing")
myLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("B2").Copy Destination:=.Range("B2:B" & myLastRow)
Application.CutCopyMode = False
End With
End Sub
Its solved. Thanks a lot.
Range("B2").Copy
The above will grab by default from the Activesheet
you have to tell it what sheet you would like it to pick that range/value from.
sheets("Parsing").Range("B2").Copy
Edit: Just noticed your With
To actually use a with you need to use a "." e.g. your copy line would look like below
.Range("B2").Copy
One other thing to note this:
Range("B2:B" & myLastRow).Select
ActiveSheet.Paste
Is rather inefficient, below would be better. Selecting in general is best to keep away from it is rather slow
Range("B2:B" & myLastRow).Paste
Or with your with
.Range("B2:B" & myLastRow).Paste
I just copied and pasted your code and ran it. I changed nothing in your code except for adding "Option Explicit" before your sub. (Just a personal habit)
Option Explicit
Sub drag_formula_original()
Dim myLastRow As Long
With Worksheets("Parsing")
myLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Range("B2").Copy
Range("B2:B" & myLastRow).Select
ActiveSheet.Paste
Application.CutCopyMode = False
End With
End Sub
I did, however, use a very simple formula in cell B2. What I did was have column A go from 1 to 10 and column C go from 11 to 20. Cell B2 was =A2+C2.
After running the code I checked each cell in column B and they each had the correct formula in them, and not a hard-coded value.
A trick I do when I want to do something like this but can't figure out how is I record a macro of me dragging the cell formula down a little ways and then stop the recording and look at the code it made. From that you should be able to adjust it to do what you want.
When I did that I got this code:
Sub Macro1()
'
' Macro1 Macro
'
'
Range("B2").Select
Selection.AutoFill Destination:=Range("B2:B15"), Type:=xlFillDefault
Range("B2:B15").Select
End Sub

copy and paste to table in a more efficient way

I have an excel file with 2 sheets:
1.INFO (huuuge table, around 10.000 rows)
2.ADD INFO
The second is where my issue is. Basically it has 2 functions, either filter (based on 2 different criteria) and search for info in the table and display it on that sheet or add a new row to the table. The macros i made work fine, but it seems weird to me that 1 minute is too long for it to complete the task:
Sub Search_in_table()
Dim header As Range
Sheets("ADD INFO").Select
Range("A13").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Delete Shift:=xlUp
If Worksheets("ADD INFO").[Item_to_search] = "Cust_ID" Then
Sheets("INFO").Select
Set header = [A1:Y1]
With header
.AutoFilter Field:=6, Criteria1:=Worksheets("INFO").[What_I_Want]
End With
ElseIf Worksheets("ADD INFO").[Item_to_search] = "ASIN" Then
Sheets("INFO").Select
Set header = [A1:Y1]
With header
.AutoFilter Field:=4, Criteria1:=Worksheets("INFO").[What_I_Want]
End With
End If
ActiveSheet.AutoFilter.Range.Copy
Sheets("ADD INFO").Select
Worksheets("ADD INFO").[A13].PasteSpecial
Sheets("INFO").Select
header.Select
Selection.AutoFilter
Sheets("ADD INFO").Select
End Sub
And this is the one to add a new row:
Sub add_esc()
Sheets("ADD INFO").Select
Range("Y9:A9").Select
Selection.Copy
Sheets("INFO").Select
Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
Selection.PasteSpecial
Sheets("ADD INFO").Select
Range("A9:Y9").Select
Selection.ClearContents
Is there a way to make them more efficient? Did i miss something? BTW, What_I_Want and Item_To_Search are just cells with names. An interesting fact is that during the writing of the code, i got very weird errors in things like "selection.paste", and that is why i was using a not common notation like "Worksheets("ADD INFO").[A13].PasteSpecial"
Any thoughts are greatly appreciated!!! Thanks in advance!
I'd recommend getting rid of "select" and "activate" wherever you can, should speed things up and ultimately avoid bugs. Are you able to just clear ALL cells on sheets("add info") for example? sheets("add info").cells.clear
As for the rest of the code: can't remember doing anything similiar but theory sounds OK... get rid of all those "selects" though, they just slow things down. Where you've got:
ActiveSheet.AutoFilter.Range.Copy
Sheets("ADD INFO").Select
Worksheets("ADD INFO").[A13].PasteSpecial
Instead just use this (and for extra credit, instead of using Sheets() refer directly to the sheets codename:
wsInfo.autofilter.range.copy wsAddInfo.cells(13,1) ' i.e. row 13, column 1 (col A)
Not sure about the rest of your question re: add rows etc, but using method above maybe you just need to increment that copy destination row? Or use application.worksheetfunction.counta(range) to find the last used cell rather than "select" etc...
There's the possibility that your method might actually be slower than just iterating over each row manually and copying where condition's met? Might be worth a try. Something like:
for each rgCell in rgList
if rgCell.offset(0,4) = stCrit1 _
and rgcell.offset(0,8) = stCrit2 then
rgcell.entirerow.copy wsAddInfo.cells(intDrawRow, intDrawCol)
intDrawRow = intDrawRow + 1
end if
next
And if all else fails, and i strongly recommend you get rid of all the "selects" in your code before doing this, use application.screenupdating = false at the start of your code, and application.screenupdating = true at the end of your code. Highly recommend error handling so that you set screenupdating back to true on errors too.
Cheers, Si