Copy range based on a date - excel

I'm new to VBA, my experience is basically record macros and adapt them a little bit, and i´ve been playing with a macro to copy a filtered range in sheet 1 based on a date value located in sheet 2 range "C42", the copy part is working
I have tried a couple of solutions i found on the internet but they don't work for me and I can't find the mistake (probably very simple but my lack of knowledge prevents me from finding it)
Sub CopyPaste
If Worksheets("Costos Médicos").Range("C42") = Worksheets("CC1").Range("B101") Then 'both values are visually in date format "dd/mm/yyyy" but if changed to general give a number
Call Cost1 'This is a macro currently working
ElseIf Worksheets("Costos Médicos").Range("C42") = Worksheets("CC1").Range("B102") Then
Call Cost2 'This one also works fine
end if
End Sub
'I also tried this, I've tried declaring cm as long, string, date, but all returns error 9 (again lack of knowledge)
Dim src As Worksheet
Dim tgt As Worksheet
Dim cm0 As Range
Dim cm1 As Range
Dim cm2 As Range
Set src = ThisWorkbook.Sheets("CC1")
Set tgt = ThisWorkbook.Sheets("Costos Médicos")
Set cm0 = src.Range("C42") 'This is the given date
Set cm1 = tgt.Range("B101") 'This is a date
Set cm2 = tgt.Range("B102") 'This is another date
If cm0 = cm1 Then
Call Cost1 'this Works fine by itself
ElseIf cm0 = cm2 Then
Call Cost2 'this also Works
End If
I think the problem is simple but can't find the answer, I have tried multiple solutions online but they usually are for far more complicated things that I don't understand. Any help would be greatly appreciated.

I am quite sure that one of the Worksheet Names is typed incorrectly, as Error 9 means that you called an element by name or position which is not present, so "out of range".
Change the names of the sheets to x and y for a test.
Concerning the dates: You do not need to worry about the formatting. Every whole day is represented by a whole number. Hours, Minutes etc. are fractions thereof. Dates are stored as Floating point numbers (both in cells an in VBA) and can be compared to other dates or integers with no problems.

Related

Iteration using multiple named ranges

What I'm trying to do is create a journaling spreadsheet that records the time and date of the entry at the time its submitted from a UserForm then updates the calendar on a "Splash" worksheet to change the cell interior and font colors to show that a journal entry has been created for that specific day.
I have a module created to iterate through what has already been imported from older journal entries from earlier this year and I want to change the interior color and text color of a cell in the named ranges named after the months. In the image below, the month names are not in the named ranges, just the list of numbers.
Calendar View
Basically, I want to search the dates, select and change the color of the cell of those dates in the calendar (see above). I can make it through the first month named range just fine but when it becomes a new month, it gives me run-time error 91.
Sub updateCells()
Dim rCell As Range
Dim rRng As Range: Set rRng = Worksheets("Journals").Range("A2:A44")
Dim thisDate, thisMonth, thisDay
Dim thisMonthRange As Range
For Each rCell In rRng.Cells
thisDate = Split(rCell.Text, " ")(0)
thisMonth = MonthName(month(thisDate))
thisDay = day(thisDate)
Range(thisMonth).Find(what:=thisDay).Interior.ColorIndex = 10
Range(thisMonth).Find(what:=thisDay).Font.Color = vbWhite
Next rCell
I'm am relatively new to VBA so I don't understand what would be causing the run-time error.
This takes having named ranges that are the actual names of the month, e.g., "January" list of dates (1-31) are referenced by Range("January").
I would use the following code to highlight the "18" in my Range("May") for today's date (2022-05-18):
Sub markCurrentDate()
Cells.ClearFormats
Dim currentMonth As String
currentMonth = Format(Date, "mmmm")
Dim currentDay As Long
currentDay = Format(Date, "dd")
Dim foundDate As Range
Set foundDate = Range(currentMonth).Find(currentDay)
foundDate.Interior.ColorIndex = 27
End Sub
Since we can't tell what your source cell for the date you're referring is, based on the current post, I used Date rather than a reference to a cell. The reference can be updated through, similar to being able to use With foundDate to add multiple format changes.
I think the problem is likely to be that one of your named ranges does not cover the entire range of days. February surely doesn't, you're missing the 28th!
At any rate, as a consequence (and apparently only on the second turn (a Feb 28?)), you run into the Run-time error '91', because Range(thisMonth).Find(what:=thisDay) is resolving to Nothing instead of an expected Range object once you fail to find thisDay inside the named range.
Evidently, the code cannot execute Nothing.Interior.ColorIndex = 10.
If correct, your solution should be to double-check and fix the incorrect named ranges.
Incidentally, Range(thisMonth).Find(what:=thisDay) is also superfluous. For obvious reasons, each range simply starts at 1 and increments with 1. So we could simply use thisDay as the index. Instead of this:
Range(thisMonth).Find(what:=thisDay).Interior.ColorIndex = 10
Range(thisMonth).Find(what:=thisDay).Font.Color = vbWhite
Simply use this:
With Range(thisMonth).Cells(thisDay)
.Interior.ColorIndex = 10
.Font.Color = vbWhite
End With
Update: come to think of this, if you want to insist on using Range(thisMonth).Find(what:=thisDay), you should at the very least change the snippet to Range(thisMonth).Find(what:=thisDay, LookAt:=xlWhole).
Counterintuitively, Range.Find(...) seems to accept a partial match by default (xlPart) and it actually remembers the settings you used on your last find (in the same Excel 'session'). Also, it will not always start where you expect it to do (see further this documentation and this post: Using the .Find Function VBA - not returning the first value). E.g. a realistic error depending on your settings / active cell position might be that your code (and incidentally, also the code provided by Cyril) will change the formatting for a day 10, when in fact you were trying to change the formatting for a day 1.

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

How can I create a formula using VBA to reference a dynamically offset range of cells?

This is a very strangely specific need, and the last thing I need to complete my suite of new macros.
Note: The '---' at the top of the sheet is there to represent several months of the same report going back in time
As you can see in the image linked above, I have two highlighted sections. I need to make column G the sum of E and F from the previous report's numbers. Because there is a new set of data added every day, I can't reference specific cells and it must be dynamic. The larger problem here is that my number of customers will change every so often. It will only go up and it will always be in the same order; even if a lose a customer they stay on the report in the same spot.
My only theories on how to get this done are:
Find the second to last instance of customer A and define a rng based on the offset cells to the right. My problem with this is that—to my understanding—even filling that formula all the way down will just give me the one value.
Adding =SUM((INDIRECT(ADDRESS(ROW()-5,COLUMN()-2))):(INDIRECT(ADDRESS(ROW()-5,COLUMN()-1)))) to the blank cells. My problem with this is that the -5 in the offset is able to change, and even defining it by the number of blank cells will cause a mistake the first time a new customer comes on.
Any insight would be very much appreciated. And please let me know if you have any clarifying questions; I'm happy to answer/edit the original post as needed.
It can probably be optimised further by actually pre-calculating the range, but the naive version would be:
=SUMIFS([Outstanding Mail],[Date],LOOKUP([#Date]-1,[Date]),[Customer],[#Customer])
+SUMIFS([Outstanding Faxes],[Date],LOOKUP([#Date]-1,[Date]),[Customer],[#Customer])
Which relies on the fact that your dates are sorted, and that LOOKUP returns the last value that is not greater than the supplied value, so the [#Date]-1 makes it look up the biggest date that is less than the provided date. Will not work on an unsorted range.
#Gserg got an answer ahead of me, and his solution is one good elegant line, although i think it goes on the assumption there will be items every day there (if I`m not wrong?), and your screenshot suggest they may not be consecutive days all the time.
If you are still looking at a VBA solution as well, I would do something like this:
Option Explicit
Sub addOffsetFormula()
'Declare and set your workbook
Dim wb As Workbook: Set wb = ActiveWorkbook
'Declare and set your spreadsheet
Dim shData As Worksheet: Set shData = wb.Worksheets("Data")
'Set your last row/column for a dynamic aproach
Dim lRow As Long: lRow = shData.Cells(1, 1).End(xlDown).Row
Dim lCol As Long: lCol = shData.Cells(1, shData.Columns.Count).End(xlToLeft).Column
'Declare some further variables to help
Dim R As Long, X As Long
Dim sumFormula As String
'Declare and set your array to hold your data - much faster to iterate through the array than spreadsheet itself
Dim tblData(): tblData = shData.Range(shData.Cells(1, 1), shData.Cells(lRow, lCol))
For R = LBound(tblData) + 1 To UBound(tblData) 'Iterate through your data
For X = LBound(tblData) + 1 To UBound(tblData) 'Iterate through the same data again
If tblData(R, 4) = tblData(X, 4) And X > R Then 'Check for match with the next client found (assuming clients are unique)
'Set your formula to a variable, helps with debugging
sumFormula = "=SUM(R[-" & X - R & "]C[-2]+R[-" & X - R & "]C[-1])"
'Assign the formula to the respective cell _
If the spreadsheet is massive, you might need to add some optimisation _
(ie: assign everything to an array first, then dump into the spreadsheet)
shData.Cells(X, 7).FormulaR1C1 = sumFormula
End If
Next X
Next R
End Sub
Note: It won't add anything to the first few lines or new clients, as there is nothing to match against previously, but i expect that should work the same with any formula too.

VBA Range.Find function on rounded negative numbers

I'm having an issue with a VBA macro I wrote, with the part that is intended to find a lowest value in range. The line looks like this:
Min = Application.WorksheetFunction.Min(a0eqB)
Set MinCell = a0eqB.Find(Min, LookIn:=xlValues)
And it returns Object variable or With block variable not set error. Now, I know why this happens - sometimes Find finds Nothing, and I learned how to handle this type of situations. Although, it also finds Nothing when the value that is dispayed in a cell differs from the value in Min variable.
For instance, when Min = -11.2641373534338, the value in a cell is -11.264137, and then error occurs. But if I change the number of decimal places displayed for that cell via Excel UI buttons until it is -11.2641373534338, everything works fine. Value in a cell is actually a formula calculation result if that helps.
I see two ways of dealing with this issue:
Finding out how many decimal places are being displayed and then rounding actual value so they match. But this way matching actually might go wrong, since numbers like 11.321 and 11.322 if rounded to 2 decimal places will be the same. Also, it's not possible due to the fact that I need to find the cell's adress in order to do that, and that's done in line 2 of the code above that's causing an issue.
Somehow telling Find function to use actual and not displayed numbers, but I've got no idea on how to do that. I googled for several days but still no success.
I will really appreciate you help.
There are at least two possible problems:
don't use Min as a variable name
Dim the variable you do use
For example:
Sub GetLowest()
Dim wf As WorksheetFunction
Set wf = Application.WorksheetFunction
Dim rng As Range, Lowest As Double, WhereIs As Range
Set rng = Range("A1:F9")
Lowest = wf.Min(rng)
Set WhereIs = rng.Find(What:=Lowest, After:=rng(1))
MsgBox WhereIs.Address
End Sub
when run on:
has no trouble finding B2 regardless of formatting.
Having looked at the issues with negative numbers and using it with the find function; a possible solution would be to format your search range and number to find with the same number format. (Based on code supplied by #Gary's Student)
Code is below for this.
If you don't want to alter the number formats in your spreadsheet, then a further hack would be to make a copy of the worksheet to format and find the address then delete the copy and use the address in the original sheet, but that would involve a bit more coding...
Sub GetLowest()
Dim sFormat As String: sFormat = "0.000000000"
Dim wf As WorksheetFunction: Set wf = Application.WorksheetFunction
Dim rng As Range: Set rng = Range("MinRange")
rng.NumberFormat = sFormat
Dim Lowest As Double: Lowest = Format(wf.Min(rng), sFormat)
Dim WhereIs As Range: Set WhereIs = rng.Find(What:=Lowest)
MsgBox WhereIs.Address
End Sub

Trouble Figuring out How to replace Cells in a Range with Specific Text - Excel VBScript

I must be having a brain fog at this point because I am certain this is easy to do, and in fact I have managed to create other functions that are a bit more complicated for this project.
Anyway, what I am trying to do. I have a sheet (inventory-data) and in column 1, it lists a company name, which is a same for all the rows. i.e. each of the 1900 or so rows have companyname in the first cell.
Now, while the data will always be the same at each application, the number of rows will change.
So, I need a function that will first determine what the last row of data is in the range, and then change all of the cells in column one of each record to name_company. The company names will always be the same so I can staticly assign them. Here is what I have that does not work.
I was able to get it to work another way, but it would replace text all the way down to the very last row of the worksheet, way beyond where the data stops.
Thanks!
Sub changeCompany() 'Changes company name as pulled from Agemni into proper ETA format
Dim myCell As Range
Dim RngToChange As Range 'The range of cells that need to be changed
Dim LastRow As Long 'Declare variable to help determine the last row on a variable length worksheet
Dim i As Integer
With Worksheets("inventory-data") 'set the range to change
Set RngToChange = .Columns(1)
End With
LastRow = Worksheets("inventory-data").UsedRange.Rows.Count 'Have Excel determine what the last row is.
For i = LastRow To 1 Step -1
RngToChange.Cells.Value = "name_company"
Next i
End Sub
I've always had more success with [SomeCellOrRange].CurrentRegion.Rows.Count e.g:
Range("A1").CurrentRegion.Rows.Count
UsedRange looks for any use of cells, not limited to a continuous tabular block. It also sometimes needs you to re-save the workbook before it will properly shrink after you have eliminated some rows.

Resources