I am building a timeline and would like to have years automatically be increased according to months.
Here is my current timeline:
I have a button, that is adding +1 column = (+1 month). So if I click button, following macro is triggered:
With Sheet1
.Range("K:K").Copy
.Columns("L:L").Insert Shift:=xlToRight
End With
In screenshot attached after month is again January, year should already be 2021.
I have tried to do so:
B33
=YEAR(OtherData!$P$17)
C33 (all other cells to the right)
=YEAR(OtherData!$P$17)+IF(B34="January";1;0)
this works, but then I get 2021 only in M33. How to make formula copy previous cell until January is reached in row 34?
EDIT:
This seems to work C33 (all other cells to the right):
=IF(C34="January";YEAR(OtherData!$P$17)+IF(C34="January";1;0);B33)
but after VBA is triggered, everything gets messed up again...
EDIT 2:
I think formula is now correct, but macro should be edited somehow to copy paste from the end all the time and not operate with defined cells like now K and L.
OR
Just fill range C33 -> to the right with formula =IF(C34="January";YEAR(OtherData!$P$17)+IF(C34="January";1;0);B33) after triggering the macro. Have to find UsedRange probably somehow.
EDIT 3:
This seems to be like working solution:
Sub Add_One_Year()
Dim lColumn As Long
With Sheet1
.Range("L:L").Copy
.Columns("K:K").Insert Shift:=xlToRight
End With
lColumn = CashflowSheet.Cells(33, Columns.Count).End(xlToLeft).Column
Sheet1.Range(Cells(33, 3), Cells(33, lColumn)).Formula = "=IF(C34=""January"",YEAR(OtherData!$P$17)+IF(C34=""January"",1,0),B33)"
'MsgBox ("The last used column is: " & lColumn)
End Sub
I wouldn't try and figure the year out - add an actual date to the cell and format it to show the month or year as required. When you add a month the year will automatically increase in January.
Add your first date into cell B34 and give a custom number format of mmmm. In cell B33 use the formula =B34 and give a custom number format of yyyy.
Execute this code to add the next month:
Sub Test()
Dim LastCol As Long
With ThisWorkbook.Worksheets("Sheet1")
LastCol = .Cells(34, .Columns.Count).End(xlToLeft).Column
With .Cells(34, LastCol + 1)
.FormulaR1C1 = "=EOMONTH(RC[-1],0)+1"
.NumberFormat = "MMMM"
End With
With .Cells(33, LastCol + 1)
.FormulaR1C1 = "=R[1]C"
.NumberFormat = "YYYY"
End With
End With
End Sub
Related
I have some code, can someone explain how it works and why it works that way? Specifically this line of code:
With Sheets("Sheet2")
.Cells(1, 1).End(xlDown).Offset(1).Value = Format(Date, "dd/mm/yyyy")
Now I get it that the code itself outputs the date in Cells(1,1) and offsets by 1 from the bottom for every subsequent entry. What I don't understand is why in the sheet itself one of the cells is blocked out?
And then the code works fine. But if cell A2 doesn't have '-------- it suddenly doesn't work anymore and gives me Application defined, object defined error. Can someone explain what '-------- does here and why its used?
The idea of the code is: "Jump to the last row that is used in column A, go down 1 row and write the date into it.
What it does:
Go (virtually) to cell A1 and press (also virtually) the key Ctrl+Down. This jumps to the last used cell of a column - but only if there is more than one cell filled, else it will jump to the very last row of the sheet (try this in Excel to understand).
Now if you offset one row from the very last row of a sheet, Excel cannot do anything more than complain.
The solution: Use .Cells(.rows.count, 1).End(xlUp) instead. This works the opposite way: Go to the very last row and press Ctrl+Up. For more details how to find the last used cell, see
Error in finding last used cell in Excel with VBA
What you also should do:
Don't cascade things, use intermediate variables, that helps debugging.
Don't write a date as string (format converts a date into a string). Write the date as date and set the number format of the cell.
With Sheets("Sheet2")
Dim lastCell as Range
Set lastCell = .Cells(.rows.count, 1).End(xlUp)
lastCell.Offset(1).Value = Date
' If needed:
' lastCell.Offset(1).NumberFormat = "dd/mm/yyyy"
End With
When there is no value in A2, it will give you an error because End(xlDown) from A1 will take you to the last cell A65536 in Excel 2003 and A1048576 in Excel 2007+. It is like selecting cell A1 and manually pressing the End key and then the Down arrow key. And of course you can't offset down from the last cell and hence you are getting the Error 1004 - Application-defined or Object-defined error.
I recommend using xlUp to find the last row and then enter the data as shown HERE
Here is an example
Dim lRow As Long
With Sheets("Sheet2")
lRow = .Range("A" & .Rows.Count).End(xlUp).Row + 1
.Cells(lRow, 1).Value = Format(Date, "dd/mm/yyyy")
End With
Im trying and failing to create a VBA formula for a command button which will take the value of cell S2 and add it with the value of the last cell of column G (this column is constantly being added to therefor making the row different each time). I want to place the result in the last cell of column I (again it is always being added to).
Help would be gratefully received, many thanks
This code would do that, you just need to have your command button run this sub:
Sub pasteLast()
Dim lrowG, lrowi As Integer
lrowG = Cells(Rows.Count, 7).End(xlUp).Row
lrowi = Cells(Rows.Count, 9).End(xlUp).Row
Cells(lrowi, 9).offset(1,0) = Range("s2") + Cells(lrowG, 7)
End Sub
just be careful because every time you click the button, it will add a value to column I whether it's unique or not. This would be better handled with a
Sub Worksheet_Change
event, where anytime S2 was changed it would add its value to column I.
Sounds like you need to find the last cell reference in column G, then go to 1 row past the last cell reference in column I, and as the cell reference in column G to S2.
This should work:
Sub addToI()
Dim gTarget As String
Range("G1").Select
Selection.End(xlDown).Select
gTarget = Selection.Address(ReferenceStyle:=xlR1C1)
Range("I1").Select
Selection.End(xlDown).Select
Selection.Offset(1, 0).Select
ActiveCell.FormulaR1C1 = "=" & gTarget & "+R2C19"
End Sub
Iv'e been breaking my head over this.
My first sheet contains these buttons:
ImageButtons
With this being the transportFile:
transportFile
So I'm trying to make it so that just the rows that contain (in this case) January and february dates get pasted to the "2016" sheet.
This is the code that I'm using right now:
If CheckBoxJanuary.Value = True Then
Worksheets("2016").Range(Worksheets("2016").Cells(2, 1), Worksheets("2016").Cells(janCount, 13)).Value = Worksheets("transportFile").Range(Worksheets("transportFile").Cells(2, 1), Worksheets("transportFile").Cells(janCount, 13)).Value
End If
If CheckBoxFebruary.Value = True Then
Worksheets("2016").Range(Worksheets("2016").Cells(janCount + 1, 1), Worksheets("2016").Cells(janCount + febCount, 13)).Value = Worksheets("transportFile").Range(Worksheets("transportFile").Cells(janCount + 1, 1), Worksheets("transportFile").Cells(janCount + febCount, 13)).Value
End If
"janCount" and "febrCount" represent the numbers of rows that contain January and february dates. This is being calculated in the transportFile with
"=SUMPRODUCT(--(MONTH($A$2:$A$150)=1))"
and
"=SUMPRODUCT(--(MONTH($A$2:$A$1500)=2))"
Afterwards, I run a loop that deletes the empty rows in the 2016 sheet.
Now I have 2 questions:
In the sumproduct formula of January I had to reduce the range because excel counts every empty cell as a January one. It's almost October, so that's not a problem now. But in 2017, when there's no data yet, there will be 150 January dates. How can I solve that?
If someone (by mistake) puts a March in between the Februaries, my ranges get all messed up. How can I avoid this?
If your column with dates is formatted properly as date, then why don't check for value of month(cell)?
You could do check for each combobox while looping through all cells in column A
like
If combo box "January" selected Then
'month = 1 and non empty
If (Month(Cells(i, 1).Value) = 1) And (Cells(i, 1) <> "") Then
'copy your rows to new sheet
End if
End if
If combo box "Feb" selected Then
'month = 2 and non empty
....
As for 1. " excel counts every empty cell as a January one" probably they can be excluded somehow, a crude way would be to do exact same sumproduct for all empty cells in a column and subtract them :)
=SUMPRODUCT(--(MONTH($A$2:$A$150)=1))-SUMPRODUCT(--(($A$2:$A$150)=""))
EDIT
Ok I had to check the sumproduct, correct way is to use second array to check for cells that are non empty:
=SUMPRODUCT(--(MONTH($A$2:$A$37)=1);--(($A$2:$A$37)<>""))
This will return count of cells that have month(cell)=1 AND cell.value <> empty so you don't get false count for January when empty cell returns month=1
As for 2 if you would make the loop using VBA to go through all your data then it doesn't matter if they are in order or not as each cell month value will be read, irrespectively of order.
EDIT 2
I will not propose the solution for this option but maybe the Pivot table could be the good solution for that task? VBA code could be use to modify displayed data in the pivot table depending on the selected checkboxes.
This code will look at each checkbox on the sheet to decide which has been ticket (assuming the only checkboxes you have are for months and they're all named CheckBoxMMMMM).
It then filters by those months and copies the filtered rows to the final sheet.
Sub CopyFiltered()
Dim wrkSht As Worksheet
Dim shp As Shape
Dim FilterMonths As Collection
Dim vItem As Variant
Dim rLastCell As Range
Dim rFilterRange As Range
Dim vFilterString() As Variant
Dim x As Long
Set wrkSht = ThisWorkbook.Worksheets("TickBoxSheet")
Set FilterMonths = New Collection
'Get a collection of ticked dates.
'This works by looking at each checkbox on the sheet.
'It assumes they're all called 'CheckBoxMMMM' so it can build a real date from the name.
For Each shp In wrkSht.Shapes
If shp.Type = msoFormControl Then
If shp.FormControlType = xlCheckBox Then
If shp.ControlFormat.Value = 1 Then
FilterMonths.Add DateValue("1 " & Replace(shp.Name, "CheckBox", ""))
End If
End If
End If
Next shp
'Create an array of "1 ,<date>,1 ,<2nd date>"
x = 1
ReDim vFilterString(1 To FilterMonths.Count * 2)
For Each vItem In FilterMonths
vFilterString(x) = 1
vFilterString(x + 1) = Format(vItem, "m/d/yyyy")
x = x + 2
Next vItem
'Apply the filter - the commented line works but is hardcoded.
'The other filter line appears to be the same as the commented line, but isn't working....
With ThisWorkbook.Worksheets("2016")
If .AutoFilterMode Then .AutoFilterMode = False
Set rLastCell = Sheet2.Cells.Find(What:="*", After:=.Cells(1, 1), SearchDirection:=xlPrevious)
Set rFilterRange = .Range(.Cells(1, 1), rLastCell)
rFilterRange.AutoFilter Field:=1, Operator:=xlFilterValues, Criteria2:=vFilterString
'Copy the visible filtered cells to the transportfile sheet.
.Range(.Cells(1, 1), rLastCell).SpecialCells(xlVisible).Copy Destination:=ThisWorkbook.Worksheets("transportfile").Range("A1")
End With
End Sub
From what I can find on the internet the numerical value given to the array (1) returns all values in that month. Other values available are:
0 year
1 month
2 day
3 hour
4 minute
5 second
I have to write a vba code that convert all dates in a year into days in a week eg. Monday, Tuesday, Wednesday....Sunday and the value of all days in a week eg.Monday must be in a string format. (See image inserted)
I tried using the .NumberFormat function but it does not work since the format is still under the date format although the values displayed are correct (please look at the formula bar of F10). Below is the code I have written:
Sub convertdate()
Range("A7:A371").Copy
'copy all the dates throughout the year'
Range("F7:F371").PasteSpecial xlPasteFormulasAndNumberFormats
'paste it into F column'
Worksheets("Sheet1").Range("F7:F371").NumberFormat = "dddd"
'convert the dates into days'
Sum1 = Application.SumIf(Range("F7:F371"), "Monday", Range("B7:B371"))
'example of calculating the total rainfall of all Mondays throughout the year'
Worksheets("Sheet1").Range("G22").FormulaArray = Sum1
End Sub
The formula bar from cell F7:F371 should display the string value "Monday","Tuesday" etc depending on the dates rather than the date itself.The reason of converting it into a string is so that it could be use in a SUMIF function later on to calculate the total rainfall of all Mondays,Tuesday etc.
Appreciate if anyone could help. Thank you.
A formula can do this.
In cell F7 enter =TEXT(A7,"dddd") and drag down.
This will format the date to show the full day name as a string.
https://support.office.com/en-us/article/TEXT-function-20d5ac4d-7b94-49fd-bb38-93d29371225c
Try something like this. It will loop through all the dates in Column A (starting in row 7) and put the associated Weekday name in Column F:
Sub test()
Dim i As Long
Dim lRow As Long
With ActiveSheet
lRow = .Cells(.Rows.Count, 1).End(xlUp).Row
For i = 7 To lRow
.Cells(i, 6).Value = WeekdayName(Weekday(.Cells(i, 1).Value, 1), False, 1)
Next i
End With
End Sub
I'm making this more challenging in my head than it has to be, but since I haven't been using vba or excel recently I'm using this as my excuse. Please don't question the methodology :) as this is only a small step I'm trying eliminate for someone to save some time, until I can redo the entire process. I would do the reverse, but this is an invoice of sorts that they are using....
I'm thinking macro or function is what is needed and not a formula since the data on worksheet 2 will change each month and there is no date I can reference.
What I'd like to do:
I have a cell on worksheet 2 that will change once a month. I want to place the value of the cell from Worksheet 2 into a cell in worksheet 1 each month that she changes it.
Each month would be represented in column A and the value of the cell from Worksheet 2 during that month needs to be place in column B.
Column A Column B
12/5/2012 $3,459,877.81
1/8/2013 $9,360,785.62
2/8/2013
3/8/2013
4/8/2013
So when she changes worksheet 1 for February the number will populate next to 2/8 and so on. I was thinking do it when she saves the document, or make it a shortcut she can hit or just scrap it and tell her it's not worth.
Giving a Cell a name to reference from you can do some neat stuff with the Target parameter passed to the Worksheet_Change function:
'Add this function to the sheet that has the cell being
'+changed by the user (Sheet 2)
Private Sub Worksheet_Change(ByVal Target As Range)
Dim strCellName As String
strCellName = "ChangeMe"
'If the cell we changed was the ChangeMeCell
If Target.Address = Sheet2.Range(strCellName).Address Then
'Store value
Dim intLastRow, intValue As Integer
intValue = Range(strCellName).Value
'Find the cell in Sheet 1 Column A that matches this month
intLastRow = Sheet1.Range("A:A").End(xlDown).Row
For Each cl In Sheet1.Range("A1:A" & intLastRow).Cells
'Ensure cell value is date
If IsDate(cl.Value) Then
'If date is today's date
'Note that Math.Round(<date>, 0 ) essentially removes the time
'+from any date value so #01/02/03 04:05:06# becomes #01/02/03#
If Math.Round(cl.Value,0) = Math.Round(Now,0) Then
'Update column B's value
Sheet1.Range("B" & cl.Row).Value = intValue
End If
End If
Next
End If
End Sub
This assumes you have the sheet layout with the "invoice values" in Sheet1 and the cell being changed in Sheet2. You need to give that cell a name.
Using the cell Name box to the left of the Function bar call the cell that changes "ChangeMe" or anything you wish to change it to, update that cell name in the first line of the function and this function will do all the rest.
It is important to note that the dates must be correctly formatted for your systems region. to make sure it is showing the right month - format them into LongDate so you can see them as 08 March 2013 instead of 03/08/13 which may get confusing the longer it goes on. Speaking as a British programmer, dates are the bane of my life!
Edit: I have update the code to compare the dates by the full date minus the time, instead of the previous monthly comparison, if you still need to subtract or add a month to either date value, just use the DateAdd("m", <date>, <value>) to add or subtract the month.
Edit: DatePart Function page is a useful resource for those wanting to know more about DatePart()
For my example, I'm using cell G4 as the one that will be updated by your coworker. You have to have some way to persist the original value of G4 in order to tell when it's been changed. The easy way to do this is to pick some cell that is out of sight of the user and store the number there so you can reference it later. Here I've chosen cell AA1. The following code must be added specifically to Sheet2 since it needs to monitor the changed events on that sheet only so it can fire when G4 is updated.
Private Sub Worksheet_Change(ByVal Target As Range)
If Range("G4") <> Range("AA1") Then
Dim lastRow As Long
Range("AA1") = Range("G4")
lastRow = Worksheets("Sheet1").UsedRange.Rows.Count
Worksheets("Sheet1").Cells(lastRow + 1, 1).Value = Date
Worksheets("Sheet1").Cells(lastRow + 1, 2).Value = Range("AA1")
End If
End Sub
Keep in mind that this is a very "quick and dirty" approach for this task, as there are no error handlers or much flexibility in the way it works.
EDIT --
One other method you could use is referenced here, and can simply check to see if a given cell has changed, without verifying the difference in value.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Range("G4"), Range(Target.Address)) Is Nothing Then
Dim lastRow As Long
Range("AA1") = Range("G4")
lastRow = Worksheets("Sheet1").UsedRange.Rows.Count
Worksheets("Sheet1").Cells(lastRow + 1, 1).Value = Date
Worksheets("Sheet1").Cells(lastRow + 1, 2).Value = Range("AA1")
End If
End Sub
Now, I'm able to capture the value from a formula in the cell and place it in a different cell in another worksheet. Here's my final product:
Private Sub Worksheet_Calculate()
Dim strCellName As String
strCellName = "ChangeMe"
If Sheets("Application of Moneys").Range(strCellName).Address <> PrevVal Then
Dim intLastRow, intValue As Long
intValue = Range(strCellName).Value
'Find the cell in Sheet 1 Column A that matches this month
intLastRow = Sheets("Certificate 1").Range("B:B").End(xlDown).Row
For Each cl In Sheets("Certificate 1").Range("B13:B25" & intLastRow).Cells
'Ensure cell value is date
If IsDate(cl.Value) Then
'If date is today's date
'Note that Math.Round(<date>, 0 ) essentially removes the time
'+from any date value so #01/02/03 04:05:06# becomes #01/02/03#
If DatePart("m", cl.Value) = DatePart("m", Now()) Then
'Update column B's value
Sheets("Certificate 1").Range("H" & cl.Row).Value = intValue
End If
End If
Next
End If
End Sub