I am attempting to change sheet names while increasing selected dates by one (1) year.
OCT is the beginning of a new fiscal year (FY) and I'm trying to adjust accordingly. For example OCT-17, NOV-17, DEC-17, JAN-18, etc. I'm trying to change to OCT-18, NOV-18, DEC-18, JAN-19 in order to clear previous data and enter the new FY information.
Thus far, I have been able to adjust sheet names, however I am stumbling on being able to "select" the range of dates that I am attempting to adjust for the new FY. I am attempting to select the range of dates and add one (1) year to each of the dates in order to reference accurate data as the table references a pivot table as its data source.
Dim MyDate As String
Dim Cell as Range
MyDate=Format(DateSerial(Year(Date), Month(10), 1, "yy")
If FormMonth = "OCT" then
sheet1.name = "FY" & MYDate - 3
sheet1.range("B9:M9").select
For Each Cell in selection
cell.value = DateAdd("yyyy", 1, CDate(cell.value))
Next cell
End If
I have MyDate - 3 to change the sheet names as I have separate sheets that hold the previous 3 years of FY data. That successfully changes the year to the FY information I would like to present.
My script is not liking the sheet1.range("B9:M9").select.
You need to set sheet1 to a worksheet:
mySheetName = "FY" & MYDate - 3
Set sheet1 = Worksheets(mySheetName)
That said, you really want to avoid using Activate/Select in your code. Something like:
For Each Cell in sheet1.range("B9:M9")
cell.value = DateAdd("yyyy", 1, CDate(cell.value))
Next cell
Related
I need to lookup a specific cell in another worksheet that has today's date as value, and edit the value of its adjacent cell by +1.
I am attempting to create a 'Points Tracker' for my studies. I will award myself one point for every task I complete. I have a workbook with two worksheets ('Sheet1' and 'data').
On the 'Sheet1' worksheet, I will have a visual look of my progress with a dynamic heatmap ranging from the past 27 weeks. Also a button at the top, which I intend to press every time I finish a task to add one point to my daily tally.
On the 'data' worksheet, I have a simple table with two columns (columnA will be the date ranging from 2022 to 2026 & columnB the points for each day.
I linked the values in the columnB of the data's table to the dynamic heatmap in Sheet1, which means, when the points in columnB are edited, I will see them live in the heatmap.
Now, I need to add points to today's date in the data's table. Like what Vlookup does, but instead of returning the value in the range's column2, I want to edit it by 1.
This appears to be very similar to what I want.
I tried the following, which results in an error:
Private Sub Worksheet_Change()
Dim temp As Range
If Not Intersect(Target, Range("E3")) Is Nothing Then
Set temp = Range("data!A:A").Find(Trim(Range("E3")), LookIn:=xlValues, lookat:=xlWhole)
If Not temp Is Nothing Then
Range("K3") = temp.Offset(0, 1)
temp.Offset(0, 2) = Range("Q3")
End If
End If
End Sub
Something else that I tried was to assign a specific cell in Sheet1 for today's points (Sheet1!$A$1), and then adding the following formula to the cells in columnB of the data table: =If(A1=TODAY(),Sheet1!$A$1,B1).
This way, if I were to add a simple +1 button to that (Sheet1!$A$1), the data table would populate accordingly. However, there's a circular reference in that formula that messes up my heatmap.
Personally, I would cut out the Intersect function as it's not really applicable and additionally change the event to Button1_Click since you only want it to run when the button is clicked anyways.
Sub Button1_Click()
Dim temp As Range
Set temp = Range("data!A:A").Find(What:=Format(Date, "d/m/yyyy"), LookIn:=xlValues, LookAt:=xlPart)
If Not temp Is Nothing Then
temp.Offset(0, 1).Value2 = temp.Offset(0, 1).Value2 + 1
End If
End Sub
You would also ideally put this in your workbook's ThisWorkbook project.
We currently have a spreadsheet that is used for scheduling, the gentleman using it doesn't want it changed so what I was thinking was create a new sheet with different formatting using VBA or a macro or?? I will then be able to import the new sheet into access where it is needed for a different program. I am attaching 2 different pictures the first is what it looks like now and 2nd is what I would like it to look like.
Old format
Better picture of Old Format
New format
. I have not done a lot of coding in Excel, normally just ='Sheet1'!E5, but didn't see how I could move the date properly and then not have the date show up any where else. The schedule may have 1 item assigned for a day or multiple items. If I have left something out that would be helpful please let me know.
If I understand you correctly...
The old format is something like this :
The expected result for the new format :
If that's what you mean...
Sub test()
Dim rg As Range: Dim cell As Range
Dim rgCnt As Range: Dim cnt As Long
Sheets("Sheet1").Copy Before:=Sheets(1)
With ActiveSheet
.Name = "TEST"
.Columns(1).Insert
.Range("A1").Value = "DATE"
Set rg = .Range("C2", .Range("C" & Rows.Count).End(xlUp))
End With
For Each cell In rg.SpecialCells(xlCellTypeBlanks)
Set rgCnt = Range(cell.Offset(1, 0), cell.Offset(1, 0).End(xlDown))
If cell.Offset(2, 0).Value = "" Then cnt = 1 Else cnt = rgCnt.Rows.Count
cell.Offset(1, -2).Resize(cnt, 1).Value = cell.Offset(0, 1).Value
Next
rg.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub
There is a consistent pattern in the old format, where to the right of each blank cell in column B is the date. So we use the blank cell in column B as the benchmark to get the date in column C.
The process:
it copy sheet1 where the old format is.
name the copied sheet to "TEST"
insert one column, and put the header name "DATE"
since HD-2 now is in column C (after insert one column)
so the code make a rg variable to data range in column C.
Then it loop to only the blank cell in rg
set the range to check how many data under each date into rgCnt variable
if the looped cell offset(2,0) is blank then there is only one data under the date so it make the value of cnt variable = 1
if the looped cell offset(2,0) is not blank then there is more than one data under the date, then have the value of cnt from the rgCnt rows count.
then it fill column A (DATE header) with the date as many rows defined by the cnt value.
After the loop done, it delete the entire row of all blank cell in rg variable.
I'm trying to help a colleague out with their spreadsheets (on MAC Excel V16.16.8), since I have some experience with coding, mostly in SQL, only very very basic level of VBA.
They receive daily data (which is why VBA is needed) which I have managed to split into separate sheets for them using basic macros.
The name of the sheet is "Birmingham" in this example.
Column B "Interval" are the hours of the day (24 hour clock). They only receive any data for the hours of the day where data actually exists in other columns. However, for their reports, they need to add/insert new rows even where there isn't any data from 0-23 (midnight-11pm).
The "Interval" column needs the correct hour/number in this descending order as seen in the example, with the Date and Campaign columns just being the same throughout. And have the rest of the cells for Total_Calls, Closed, etc, containing "0"s.
How do I add the new rows, "Intervals", and the "0"s?
I have tried a couple of different ways mostly around attempting to merge a mostly blank separate table only containing all of the "Intervals" 0-23. However, I have failed miserably in each method.
I am almost 100% sure there is a relatively simple method of doing this, but I lack specific VBA knowledge.
Any help would be most appreciated.
Thanks
You can get the current date and current campaign and insert missing rows like this:
Private Sub FillAllHours()
Dim i As Long
Dim myDate As Date ' value from date column
Dim myCampain As String ' value from campaign column
With ActiveSheet
myDate = .Cells(.Rows.Count, 1).End(xlUp).Value
myCampain = .Cells(.Rows.Count, 3).End(xlUp).Value
For i = 2 To 25
If .Cells(i, "B") <> i - 2 Then ' if row is missing
.Rows(i).Insert ' insert row above
.Cells(i, "B") = i - 2 ' insert hour number
.Cells(i, "A") = myDate ' insert date
.Cells(i, "C") = mycampaign ' insert campaign
.Cells(i, "D").Resize(1, 9).Value = 0 ' fill 9 cells with 0
End If
Next i
End With
End Sub
I have the following Excel Table:
Create Date Last Active Date Age
4/12/2017 5:54 4/17/2020 8:54 5 Days
4/19/2017 7:43 #N/A
4/12/2017 20:43 #N/A
4/1/2017 23:20 4/3/2017 6:54 10 Days
4/15/2017 22:20 #N/A
What I want to do is to filter the Age Column by #N/A, and then copy each Last Active Date value to the same row in Create Date. Seems easy enough, but I keep running into issues. I am using the SpecialCells(xlCellTypeVisible) property to then do a for each on each Area in there(non-contiguous rows), but when I go to copy the rows, it either copies the rows starting at Row 1 of the Create Date column, meaning the values get all out of whack OR it throws an error saying the ranges don't match. Here is the code I have so far that I pulled from another page that talked about how to do this, but it doesn't seem to work for me.
ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=8, Criteria1:= _
"#N/A"
Dim lngrow As Long
Dim FinalDest As Range
Dim Rng As Range
lngrow = Sheets("Sheet1").UsedRange.Rows.Count
Set FinalDest = Sheets("Sheet1").Range("C2:C" & lngrow)
Range("F2:F" & lngrow).Select
For Each Rng In Cells.SpecialCells(xlCellTypeVisible).Areas
Set FinalDest = FinalDest.Offset(Rng.Rows.Count)
Rng.Copy Destination:=FinalDest
Next Rng
Application.CutCopyMode = False
How can I accomplish this? I want to filter it by #N/A, and then for each filtered row that remains, copy the value in Last Active Date to Create Date, (which will always be blank for these rows) and make sure they get copied to the proper rows, ie if Row 3 is the first filtered row, the value gets copied to rows 3 instead of row 2.
You don't need to filter your table. You have two feasible solutions:
Solution 1 (without VBA):
Assuming that Create Date is at A1:
-Insert a new column between Create Date and Last Active Date.
-Insert this function to B2--> =IF(A2="",IFNA(D2,C2),A2)
-Copy paste B2 till end of your column
-Copy all B column and paste them as values.
-Delete Column A
Solution 2 (with VBA):
You can loop through each row and check if the Age cell is #N/A, if true(#N/A), then you do the copy/paste from Last Active Date cell to Create Date Cell.
Solution 1 is much faster and easy. If you are interested in VBA solution let us know.
Edit: You can always change the following code for different conditions but since you said --> Create date value (which will always be blank for these rows):
Dim i As Long
For i = 2 To Range("C1").End(xlDown).Row
If IsEmpty(Cells(i, 1).Value) Then
Cells(i, 1) = Cells(i, 2)
End If
Next i
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