Issue sorting dates with DDMMYY end of month - excel

I've created a sub-routine which orders the ActivityDate column smallest to largest. The dates are formatted like DDMMYY so for example, 010621 would be the first this month, 300621 would be the last.
My issue is that I conduct reports weekly which means that on occasion, I will get the last day / days of the previous month. When this happens, those dates will be placed at the bottom, as 30 comes after 01 numerically e.g. 310521 will appear at the bottom of the spreadsheet, 010621 will appear first.
I know that I can add a column for month, use =MID(date, 3, 2) and sort the month number first but is there any simpler way of doing this?
This is my code for sorting the dates:
Sub SortDates()
Dim ActDate As Long
Dim ActDateLetter As String
sheet = "Overall Activity"
With ThisWorkbook.Worksheets(sheet).Rows(1)
Set b = .Find("ActivityDate", LookIn:=xlValues)
ActDate = b.Column
'Convert To Column Letter
ActDateLetter = Split(Cells(1, ActDate).Address, "$")(1)
End With
ThisWorkbook.Worksheets(sheet).Activate
ThisWorkbook.Worksheets(sheet).Columns(ActDate).Sort Key1:=Range(ActDateLetter & "1") _
, Order1:=xlAscending, Header:=xlYes
End Sub

Related

Is there any better way other than checking every single cells in a column of data?

In Column A and B, I have "date and time" and "hourly measurement" data.
Column A indicates the date and time, and B is the measured data on hourly basis. What I wanted to do is to calculate daily averages.
What I did is adding column C showing the number of the day of a month, adding column D calculating the daily averages of data on column B, and adding column E for extracting the daily average in daily basis.
My code is:
Sub dailyAverages ()
Range("C2:C" & Range("B" & Rows.Count).End(xlUp).Row).Value = "=DAY(A2)"
Range("D1") = "daily average"
Range("D13:D" & Range("B" & Rows.Count).End(xlUp).Row - 11).Value = "=AVERAGE(B2:B25)"
Range("E1") = "IF"
Range("E2").Select
Do Until ActiveCell.Offset(1, -2).Value = ""
myCell1 = ActiveCell.Offset(0, -2)
myCell2 = ActiveCell.Offset(1, -2)
If myCell1 <> myCell2 Then
ActiveCell.Value = ActiveCell.Offset(0, -1)
ActiveCell.Offset(1, 0).Select
Else
ActiveCell.Offset(1, 0).Select
End If
Loop
End Sub
The code gets the work done, however, it runs somewhat slow because the if statement checks the rows one by one and the number of data can reach up to 130 00 rows in some files.
I am a very beginner on VBA. Is there any faster way how to do so?
You were on the right track. The AVERAGEIF() function accepts 3 parameters, the cell range containing the desired criteria, the criteria to look for, and the cell range to average. In this case, [average_range] is not optional.
AVERAGEIF(range, criteria, [average_range])
Based on the layout you described, columns D&E would use a single row to report an average for each day, and column C&E would calculate the following. Note that E4's criteria is C19, the first cell containing the next day number:
C3=DAY(A3)
E3=AVERAGEIF(C3:C34,C3,B3:B34)
C4=DAY(A4)
E4=AVERAGEIF(C3:C34,C19,B3:B34)
etc
As Rod Rosenfeld commented, you can use a pivot chart/table. This is easy. Very little maintenance is required.
Img: Change Data in a Pivot Table

ADDRESS of cell found from LOOKUP function

What I need is the address of the cell found in a LOOKUP function.
I have a table with various client orders and payments. tbl_main
The columns relevant to my question are [Receive Date], [Credit], [Balance].
(The Balance Column is auto generated).
Here's the [Credit] column:
The first of each month is every client's payment Due Date, where he needs to pay for any work done during the month. So I need a CELL to show me what the due date is, based on these three things:
Find the last cell with a value in the [Credit] column. This alone I figured out: =LOOKUP(2,1/(tbl_main[Credit]<>""),tbl_main[Credit])
Find the [Balance] column on that same row. If it's a negative number, continue.
(client owes money on the first of next month)
Find the [Receive Date] column on that same row and calculate when his due date is
(when the first of next month is).
This Alone I already figured out: =EOMONTH(B328,0)+1but, of course, the B328 is my test cell. I would need my formula to be able to figure out the row index 4. Display this due date in a cell somewhere.
I just can't figure out how to write a formula to accomplish this without VBA.
I tried combining various methods of LOOKUP and MATCH, but get #N/A results.
Can someone help with this?
This is my code I figured out. It's specific to my own needs but maybe someone with the same question can harvest some code from it that will help.
Sub GetPaymentDueStatus()
'#################################
'Get \ Set "Payment Due" field
'#################################
'If not viewing one client - exit sub
If ActiveSheet.Range("SelectedClient") = "ALL CLIENTS" Then
Range("PaymentDueStatus") = "N\A"
Range("PaymentDueDate") = "N\A"
Exit Sub
Else
'Client has no debt
If Range("Total_All") >= 0 Then
Range("PaymentDueStatus") = "SETTLED"
Range("PaymentDueDate") = "N\A"
'Client has debt - check if on time or overdue
Else
'#################################
'Start Calculation
'#################################
Dim rownumCredit As Long
Dim colCredit As Long
Dim rngCredit As Range
Dim LastPaymentDate As Date
Dim MonthAfterPayment As Date
Set rngCredit = Range("rng_credit").Find(what:="*", LookIn:=xlValues, searchdirection:=xlPrevious)
rownumCredit = rngCredit.Row
colCredit = rngCredit.Column
'#################################
'Calculate the Last Payment date
'if it's ovedue
'#################################
'Get date of last payment
LastPaymentDate = Cells(rownumCredit, Range("rng_recDate_main").Column)
'Get next first of the month from last payment
MonthAfterPayment = WorksheetFunction.EoMonth(Cells(rownumCredit, Range("rng_recDate_main").Column), 0) + 1
'Check if overdue
If Month(MonthAfterPayment) <= Month(Date) Then
Range("PaymentDueStatus") = "OVERDUE"
Else
Range("PaymentDueStatus") = "ON TIME"
End If
Range("PaymentDueDate") = MonthAfterPayment
End If
End If
End Sub

If date = today update row, else, create new row

I am working on a userform to record counts at certain times of the day.
I automatically add the date and day to the first two fields. There are different fields for one day of the week compared to the others, hence the if statement:
Private Sub UserForm_Initialize()
If Format(Date, "ddd") <> "Sat" Then
DateWkd.Value = Format(Date, "mm/dd/yy")
DayWkd.Value = Format(Date, "ddd")
Else
DateSat.Value = Format(Date, "mm/dd")
DaySat.Value = Format(Date, "ddd")
End If
End Sub
Data will be submitted at different times of the day.
How do I find if the last row's day value equals today's day to update the row, or create a new row if the date doesn't match?
Will write out a little bit more as comments aren't great for code.
In general, you should appropriately qualify references, so in this case with using your userform, you will need to specify the sheet/etc.
Dim lr as Long, varDay as Long
varDay = 1 'assumes using ColumnA, but you could make this a Find() function if necessary
With Sheets("Data")
lr = .Cells( .Rows.Count, varDay).End(xlUp).Row
If DateTextBox.Value <> .Cells(lr,varDay).Value Then 'Not sure if you want just Date (todays' date, no time) or the value in your input for the comparison (gave arbitrary name for textbox example)
'Do your thing
End if
End With
This would be in your command button for entering data, to determine where it would go. If you need to pull data from the sheet on initialize, you would then set textbox.value = .cell references... note that these two situations are not within the same module.

Converting all dates in a year into multiple strings using Excel VBA

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

Excel Min Date in a given range

I have an Excel file with multiple columns. If you observe the attached image the 1st column is coupons (repeated with different settlement dates). I need to write a macro which will loop through the file, and find one record for each coupon with the minimum date of all the dates that particular coupon has. For example, coupon 2 has 4 records in the attached image. I should delete three off them, and have only one record with the earliest date among those four.
Can someone please provide me an example?
One possibly is to use a temporary array formula. Assuming field Coupon is column B and Date is column C then in the next free column, say column N use {=IF(C2=MIN(IF($B:$B=B2,$C:$C)),TRUE,FALSE)}
Then use an advanced filter to filter on Coupon and TRUE in Column N. In this example I've set up the criteria and output from column Q
Eg VBA Code example
Sub test()
Dim rng As Range, strR1c1 As String
'identify minimum date using array formula
With Sheet1
.Range("N1").Value = "Temp Header"
'array formula = {=IF(C2=MIN(IF($B:$B=B2,$C:$C)),TRUE,FALSE)}
.Range("N2").FormulaArray = "=IF(RC[-11]=MIN(IF(C2=RC[-12],C3)),TRUE,FALSE)"
strR1c1 = .Range("N2").FormulaR1C1
Set rng = .Range("N2:N" & .Range("B" & .Rows.Count).End(xlUp).Row)
rng.Formula = strR1c1
rng.FormulaArray = rng.FormulaR1C1
'Advanced Filter criteria requirements to new range
.Range("B1:N11").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range( _
"Q1:AC2"), CopyToRange:=.Range("Q5:AC5"), Unique:=False
'tidy up - clear array formula
.Range("N:N").ClearContents
End With
End Sub

Resources