Modify each row matching several criteria - excel

I'm designing a staffing schedule for projects.
Staff members are assigned on day-to-day basis to different projects. For planning purposes, we want both a "staff per project"-view as well as a "project per staff"-view.
This led me to create a dataset consisting of one entry for each day/staffmember combination. With a dozen-or-so staff members and 365 days, this is a lengthy list to manually modify.
Basically, this is the database:
The real thing is some 5000 lines. Changing anything a big CTRL+F party.
Ergo; a macro to add staff planning.
On a different sheet, I built a simple form for data-entry.
People select a staff member, enter a project name, beginning date, and ending date. The macro is then supposed to find the row (s) matching the staff member and the selected date range, and change the project in the dataset to whatever is given as input.
I built the dataset, and begun working on code to locate the correct lines. I figured first making some code to set everybody's 24th of December to "Christmas" would be easiest.
To make things easier on myself, I figured coloring it red would be best.
Sub AddHoliday()
Dim i As Long
For i = 1 To Sheets("2019-2020").Rows.Count
Next i
If Sheets("2019-2020").Cells(i, 1).Value = "24-12-2019" Then
Sheets("2019-2020").Cells(i, 1).Font.Color = vbRed
End If
End Sub
I expected to see every date equal to 24th of December to turn red, but I get the following error:
error 1004: Object-defined error.
On the first line of the IF-statement.

Problem:
If should have been inside For Loop
Date should be entered as Number, to be sure 24-12-2019 is recognized as 43823 by Excel
Loop was being run on all the Rows, it should have been on Active Rows in the sheet
Use:
Sub AddHoliday()
Dim i As Long
With Sheets("2019-2020")
For i = 1 To .Cells(.Rows.Count, "A").End(xlUp).row
If .Cells(i, 1).Value = 43823 Then ' 24-12-2019
.Cells(i, 1).Font.Color = vbRed
End If
Next i
End With
End Sub

Related

Excel VBA Xlookup to reference worksheet containing certain date

Still a novice at VBA but learning and ran up what i believe is a pretty advanced request.
I have a workbook our managers use that has 5 worksheets created each month. Each one is suffixed by the current Month_YYYY. I am trying to add an Xlookup to the worksheet whose date is one month prior (same prefix) and fill down to the last row.
So in this example, in B2 of the Oasis_Detail_November_2022 worksheet I would have:
=IFERROR(XLOOKUP(A2,'Oasis_Detail_October_2022'!A:A,'Oasis_Detail_October_2022'!B:B),C2) In December, it would reference the November tab and so on.
Is it even possible to do this? If it helps, the order of the tabs are always the same and i'm always looking 5 back (this example I hid a column just for screenshot room).
This is my rudimentary code thusfar. Thanks for the help.
Sub Oasis_Detail_Formatting()
Rows(2).EntireRow.Delete
Columns("A").Cut
Columns("C").Insert
[A:A].Select
With Selection
.NumberFormat = "General"
.Value = .Value
End With
Columns("B").Insert
Range("B1").Value = ("Svc Rel Parent")
ActiveSheet.UsedRange.EntireColumn.AutoFit
End Sub
I tried to use a Dim Dt As String and Dt = Format(Date, "mmmm_yyyy") statement within the Xlookup code but everyway i formatted the function, i just kept getting a debug error.

best way to select column based on current date (Excel VBA)

I have a small tracker program I am building in Excel VBA. I have a userform that I keep up throughout the day, inputting my tasks/data via an 'Add' button. At the end of the day, I click the 'Post' button, and it saves the data to my worksheets where appropriate.
Thought I had it finished and working correctly, but now apparently my sub to select the correct column based on the day's date is not working, and I'm not sure why, as it had been working perfectly throughout development.
This piece is vital, as my other functions to post the day's data rely on this. I've read a lot of other posts about how to do this (selecting a column based on current date), but none have explained why mine isn't working. Trying to become a better coder, and not just a copy/paste coder, so thought I would try asking here. Copy/Paste usually gets me into these messes, where I'm using tools/functions that work, but I don't know why, and can't troubleshoot/debug on my own.
My total project involves 5 worksheets, but this sub should only involve 2 of them. "Tasks" and "Data Tracker", both of which have a row of dates.
Below is the sub in question.
Public Sub currentDate()
'sub to assign current date to global values
Set rng - Range("H2:HZ2")
Set myDate = rng.Find(What:=Int(Date), LookIn:=xlFormulas)
End Sub
If I step through it, Date is pulling the correct date, and xlFormulas shows a value of -4123 (I don't even know if that matters)..
(UPDATE) so apparently, this morning, it decided to work perfectly. facepalm Any clues?
(UPDATE) so, per usual, I try adding features as I fix something else, so this took a bit more researching to solve, but #Super-Symmetry pointed me in the right direction! As noted in a comment down below, I changed my date headers in the two sheets to be more of a "start date + n" situation. Although his suggestion of using xlValue instead of xlFormula was on the right track, Find. was still having trouble with date vs serial. Ultimately this is what I got to work:
Public Sub currentDate()
'sub to assign current date to global values
'load the date range
Set rng = Worksheets("Tasks").Range("H2:HZ2")
'load the values in the range
dateArray = Range("H2:HZ2").Value
Dim day As Variant 'object to load dateArray
Dim loc As Integer 'matches date with cell location
'converting the date to serial
For Each day In dateArray
day = CLng(day)
loc = loc + 1
If day = Date Then 'we found the right column
Set myDate = rng(loc)
'selects the correct cell
If ActiveSheet.name = "Data Tracker" Then 'adjust the row
Cells(myDate.Row + 3, myDate.Column).Select
Else 'sheet must be Tasks
Cells(myDate.Row + 2, myDate.Column).Select
End If
Exit Sub
End If
Next
End Sub
It's not elegant, but it works.. please feel free to educate me if you have any cleaner ways to do this!
Try changing Int(Date) to CLng(Date)
Public Sub currentDate()
'sub to assign current date to global values
Dim rng As Range, myDate As Range
Set rng = Range("H2:HZ2")
Set myDate = rng.Find(What:=CLng(Date), LookIn:=xlValues)
End Sub

Excel VBA - dynamic data lookup between sheets in VBA

I have been busy working on a number of dynamic excel workbooks learning on the go through forums and content like this site, but as I am coming to the final parts that will round off my workflow I am stumped by what I assumed would be a fairly simple VBA code.
Not wanting to muddy the water with the code I currently have, I will instead explain clearly the problem I am trying to solve, and the ways I have tried to approach this. Note that I am very much a novice, and would appreciate being pointed in the direction of some code that I am able to copy and amend to suit.
Problem
I have two sheets;
"Purchase_Orders" - is a master list of total value purchase orders with information associated with the total value.
"Purchase_Ledger" - is a full list of payment transactions that include a mixture of payments which are project and non-project related.
As a project will have multiple purchase order numbers, and purchase orders have multiple payments, I am looking to lock the sheet down so that the user selects the purchase order number they are making a payment against, and the columns for project data are automatically pulled across from "Purchase_Orders" that are associated with the purchase order.
The data is structured as follows:
"Purchase_Orders"
(A,7-4000) Purchase Order number
(B,7-4000) Project Number
(C,7-4000) Project Name
"Purchase_Ledger"
(A,7-10000) Payment Reference
(B,7-10000) Purchase Order number - purchase order is selected from a drop-down list of numbers validated from the list on "Purchase_Orders"
(C,7-10000) Project Number - to be copied across
(D,7-10000) Project Name - to be copied across
My Attempts
I have already spent so much time working on this from different angles. As there are likely to be some purchases that are required that do not necessarily require a purchase order number, I want to keep the project number column open and free from formulae.
Currently, I have an index and match formulae in VBA which only works when run manually and copies the whole columns across. Ideally, I am looking for only the relevant cells to update when a purchase order is selected. I am working on code to trigger the macro when the drop-down is selected, but this is all very clumsy and not what I am seeking to achieve.
I have also tried using vlookup, but again this would only work with a trigger and not dynamic.
Hopefully, this is a sizeable challenge for some to flex their grey matter. If you need more info let me know.
Thanks!
Jon
Current code:
Sub Copy_Purchase_Orders()
Dim k As Integer
For k = 7 To 10000
Cells(k, 6).Value = WorksheetFunction.Index(Range("B7:B4000"), WorksheetFunction.Match(Cells(k, 5).Value, Range("A7:A4000"), 0))
Cells(k, 7).Value = WorksheetFunction.Index(Range("C7:C4000"), WorksheetFunction.Match(Cells(k, 5).Value, Range("A7:A4000"), 0))
Next k
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Range("E7:E1000"), Range(Target.Address)) Is Nothing Then
Call Copy_Purchase_Orders
End If
End Sub
So your current code is called whenever a selection happens in column E and then cycling through all rows from 7 to 10000 and populating it with the formula?
You could change the method to accept the cell / target / range / address and then only cycle through each of its rows (instead of 7 to 10000)
Something like this (untested because I didn't have data sample and short on time):
Sub Copy_Purchase_Orders(target As Range)
Cells(target.Row, 6).Value = WorksheetFunction.Index(Range("B7:B4000"), WorksheetFunction.Match(Cells(target.Row, 5).Value, Range("A7:A4000"), 0))
Cells(target.Row, 7).Value = WorksheetFunction.Index(Range("C7:C4000"), WorksheetFunction.Match(Cells(target.Row, 5).Value, Range("A7:A4000"), 0))
End Sub
Private Sub Worksheet_Change(ByVal target As Range)
If Not Application.Intersect(Range("E7:E1000"), Range(target.Address)) Is Nothing Then
Call Copy_Purchase_Orders(target)
End If
End Sub
edit
To reference a particular worksheet when using Range objects, you should "qualify" them with the worksheet you're targeting (it's always safer to do this, you shouldn't really use Range or Cell objects alone:
So if want to move sheet 2 data to sheet 1 data, Instead of:
Range("A1").Value = Range("A1").Value '(VBA doesn't know which Range you mean)
You write:
Worksheets("Sheet 1").Range("A1").Value = Worksheets("Sheet 2").Range("A1").Value
So, you just need to qualify the ranges in your code, I think like so:
Cells(target.Row, 6).Value = WorksheetFunction.Index(Worksheets("Purchase_Orders").Range("B7:B4000"), WorksheetFunction.Match(Cells(target.Row, 5).Value, Worksheets("Purchase_Orders").Range("A7:A4000"), 0))
I think for the purposes of your code at the minute, you can leave it there. If you decided to build more on these existing routines, you should really qualify your Cell objects too, however it would end up very wordy:
Worksheets("Purchase_Ledger").Cells(target.Row, 6).Value = WorksheetFunction.Index(Worksheets("Purchase_Orders").Range("B7:B4000"), WorksheetFunction.Match(Worksheets("Purchase_Ledger").Cells(target.Row, 5).Value, Worksheets("Purchase_Orders").Range("A7:A4000"), 0))
To cut down on mess, you can declare worksheets as variables and set them as particular sheets:
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Set ws1 = Worksheets("Purhcase_Orders")
Set ws2 = Worksheets("Purchase_Ledger")
Then use them in place of writing their full object name:
ws2.Cells(target.Row, 6).Value = WorksheetFunction.Index(ws1.Range("B7:B4000"), WorksheetFunction.Match(ws2.Cells(target.Row, 5).Value, ws1.Range("A7:A4000"), 0))
There are even more shortcuts and declarations you can use to make code more succinct, safer, reusable and scalable, if you choose to really dive into VBA coding. Ranges can be variables, using sheet codenames, using With blocks, in-line evaluate - all things that could be employed to your code so far.

Getting Excel to Copy Data From One Cell to Another Depending on Date

Apologies in advance as this is my first time posting something on this site and am not the best at explain issues.
I have a spread sheet, this has production data such as meters daily, meters monthly etc. These values are updated by adding TAGS from a PLC using Rockwell VantagePoint Excel add-in (if your unfamiliar with this it shouldn't matter this part is not what I am struggling with)
I need I way to copy data from one cell to another cell on the same sheet at month end. Basically the Meters monthly field needs to copied into another cell at the end of the month to record meters run for that month. The monthly meters run resets back to 0 at the end of the month.
Basically I need to copy the value in J7 into the corresponding month in W column at the end of that month. If it could ignore the year that would be advantageous as I don't need it to keep the old values and would mean I just need one column.
I have some experience at MS-Excel, also VBA but mainly in MS-Access never in MS-Excel. If answers could be explained as simply and hands on as possible it would be appreciated.
After Googling the issue I came across this formula and changed the ranges to fit my sheet but Excel doesn't like it saying it contains an error
=QUERY( A1:B6; "select B where A =date """&TEXT(TODAY();"yyyy-mm-dd")&""" "; 0
Sorry again if I haven't explained myself properly.
If your workbook isn't guaranteed to be open at the end of each month I would update the value every time it gets opened, like(Should be placed in ThisWorkbook):
'Runs when you open the workbook
Private Sub Workbook_Open()
'Loops through U3 to the last used cell in that column
For Each c In Range(Cells(3, 21), Cells(Rows.Count, 21).End(xlUp))
'Applies the J7 value to the current month and exits the sub
If Month(c) = Month(Now) Then c.Offset(, 2).Value = [J7]: Exit Sub
Next c
End Sub
Also, not that it matters but, I would apply the following formula in U3:U14 to always get the correct dates:
=EOMONTH(DATE(YEAR(TODAY()),ROW()-2,15),0)
Okay, I'm still not super sure what the question is and I know more Access VBA than Excel VBA, but here's something that might help to find a solution.
You can make a check date function that returns a Boolean value:
Public Function EoMonthCheck() As Boolean
Dim eo_month As Date, today As Date
eo_month = Format(WorksheetFunction.EoMonth(Now(), 0), "yyyy-MM-dd")
today = Format(Now(), "yyyy-MM-dd")
If today = eo_month Then
EoMonthCheck = True
Else
EoMonthCheck = False
End If
End Function
And the,, to add a value to the "W" column, we might use something like this:
Public Function AppendValue(Optional target_cell As String = "J7")
''' This could be a subroutine, too, I guess, since we're not returning anything.
Dim i As Integer
''' Activate whatever sheet you want to work with
Worksheets("Sheet1").Activate
If EoMonthCheck() = True Then
''' Look up the bottom of the 'W' column and find the first non-empty cell
''' Add 1 to that cell to get you to the next cell (the first empty one).
i = Cells(Rows.Count, "W").End(xlUp).Row + 1
''' Set the value of that empty cell in the 'W' column to the value of 'J7'
''' which will happen after we evaluate whether it is the end of the month.
Cells(i, "W").Value = Range(target_cell).Value
End If
Then, you could maybe trigger that each time the workbook opens.

Excel VBA - how to identify the year (date) in one cell then check another cell for the data there and then count

Help! Fairly new at Excel VBA here and I'm taking some paid courses right now to get better but I've run into a road block and googling isn't getting me the results I'm looking for.
I have an ever growing tracking spreadsheet which shows data about what we've processed (we call it "building it") in a column and then data showing we've checked (we call it as having been audited) that data we've processed in other column. I want to find the year is was processed and find if it was audited regardless of the year of the audit and if so add it up. I want to do this for every year, so 2017, 2018, 2019, 2020 etc. etc.
Then finally place the findings for each year in a dashboard cell.
E.g. search column J which contains a date we processed the data from 2017, then look at the audited column in the same row (which also contains a date) if there is anything in there and to count 1. Then do it again and again until the whole range has been checked. Each time we find a date from 2017 we add one and we do this for each year. At the end of the search the results for each year needs to be entered in the dashboard sheet.
Is there a way to write code for it to check every year instead of having to call out each year specifically?
Here's what I've gotten so far but I keep running into an error. Either "next without for" and others which I can't remember now. I've googled and added all sorts of stuff and moving it etc. etc. I'm sure I'm doing something really obviously wrong here but I'm just not seeing it. Please help a newbie out here.
Sub CountAudits()
Dim CellBuild As Range
Dim CellAudit As Range
Dim CellDateCount2017 As Long
For Each CellBuild In Sheet1.Range("J:J500") 'column J contains a date MMYYDD what we call "build" data in other words we processed it.
If CellBuild.Value = "2017" Then 'this checks if the date it was processed was in 2017
For Each CellAudit In Sheet1.Range("Q:Q500") 'this is the column containing the date it was audited. It will be blank if it was not audited.
If CellAudit.Value <> "" Then 'this checks if it's been audited. I don't care about the date just as long a there is something in the cell
CellDateCount2017 = CellDateCount2017 + 1 'if the processed date was 2017 and it was audited it adds a count of 1 to here.
Exit For
Sheet2.Range("V18").Value = CellDateCount2017 'Sheet2 is the sheet code name to the dashboard
Next ' I keep getting an "Next without for" error for this here. I've added all sorts of ends, end ifs, etc. but I can't figure it out.
End If
End Sub
I found SUMPRODUCT which I think I can use to count the number of times 2017 shows up in my column but how to I get it to add it up and get it over to the dashboard? e.g. SUMPRODUCT(1*(YEAR(J1:J500)=2017))
If only it wasn't so much fun to figure this stuff out I could just walk away from it! I've been bitten by the "this excel VBA stuff is fun" bug.
You are nesting the FOR and the IF wrong. Try the code below. I didn't check for functionality, I only corrected the loops:
Sub CountAudits()
Dim CellBuild As Range
Dim CellAudit As Range
Dim CellDateCount2017 As Long
For Each CellBuild In Sheet1.Range("J:J500") 'column J contains a date MMYYDD what we call "build" data in other words we processed it.
If CellBuild.Value = "2017" Then 'this checks if the date it was processed was in 2017
For Each CellAudit In Sheet1.Range("Q:Q500") 'this is the column containing the date it was audited. It will be blank if it was not audited.
If CellAudit.Value <> "" Then 'this checks if it's been audited. I don't care about the date just as long a there is something in the cell
CellDateCount2017 = CellDateCount2017 + 1 'if the processed date was 2017 and it was audited it adds a count of 1 to here.
End If
Next CellAudit
Sheet2.Range("V18").Value = CellDateCount2017 'Sheet2 is the sheet code name to the dashboard
End If
Next CellBuild
End Sub

Resources