Afternoon all, I'm working with two columns of data - one of these has an author name and the second has a publish date-time value. I'm looking to build up a UDF to take these two ranges, search the author column for a particular string and if found to return the value from the publish column.
Data looks similar to this;
Once it has found the author I'm looking for i want it to look at the publish time and find the minimum value for this.
For example, if i was looking for the author Ben in the above then the value returned should be 08/06/2014 17:15.
If the data i was working with was always in the same format then i would build up an array formula to create a MINIF but the columns these ranges show in are always different and the easiest option will be a UDF that the end user can just put the two ranges into.
Thanks in advance for any help.
Cheers
Your UDF might be like this, no office 365 features needed:
Function MinDateByAuthor(author As String, rngNames As Range, rngDates As Range) As Date
MinDateByAuthor = Application.Evaluate("Aggregate(15, 6," & _
rngDates.Address(External:=True) & "/(" & _
rngNames.Address(External:=True) & "=""" & author & """),1)")
End Function
You can use it like =MinDateByAuthor("Ben", A2:A100, B2:B100)
You can also place some cell address instead of the hardcoded "Ben".
TBH, all your UDF has done is facilitate a little bit typing the initial formula.
And you might want to make it even easier, by allowing full column references (A:A, B:B) without sensitive slowness. In the above UDF you can do that, but as suggested by #ScottCraner, we can make it work faster:
Function MinDateByAuthor2(author As String, ByVal rngNames As Range, ByVal rngDates As Range) As Date
Set rngNames = Intersect(rngNames, rngNames.Parent.UsedRange)
Set rngDates = Intersect(rngDates, rngDates.Parent.UsedRange)
' The rest is the same ...
MinDateByAuthor2 = Application.Evaluate("Aggregate(15, 6," & _
rngDates.Address(External:=True) & "/(" & _
rngNames.Address(External:=True) & "=""" & author & """),1)")
End Function
Here you will notice that =MinDateByAuthor2(A3,A:A,B:B) calculates faster than =MinDateByAuthor(A3,A:A,B:B).
It's suppose to look like that, just change this row:
If Cells(x,1).Value="ben" Then 'or whatever name you chose
if you want it to be some other Author
Dim x As Integer
Dim y As Integer
Dim a As Date
Application.ScreenUpdating = False
' Set numrows = number of rows of data.
NumRows1 = Range("A1", Range("A1").End(xlDown)).Rows.Count
NumRows2 = Range("B1", Range("B1").End(xlDown)).Rows.Count
Range("A1").Select
For x = 1 To NumRows1
If Cells(x,1).Value="ben" Then 'or whatever name you chose
If IsEmpty(a) Then
A = Cells(x,2)
End If
If DateValue(Cells(x,2))<A Then
A = Cells(x,2)
End If
End If
Next
Related
So, I've run into the typical date formatting issue.
Which is causing me a headache.
I can't share the data for security reasons. But, I can describe the format.
The VBA is simple enough, and she be able to be worked out.
In short,
My macro obtains its data from Col C, where the regex extracts the department and date.
I then call these in a loop to paste the data into Col A, B and finally C to replace the original data.
My issue is, Col B has a date in it.
It is extracted as "02/04/2018", but when it pastes it into the col, it appears as 04/02/2018. Which is a massive issue.
I cannot get the VBA macro to hold, or set the format. So far.
I will attach my script below and you can let me know.
Thanks!
Ps. This is the line I suspect is the issue.
ws.Range("B" & x).Value = match.SubMatches(3)
I cannot figure out how to have it set the value as extracted from the string. sigh.
Sub Link()
Dim ws As Worksheet
Dim lastRow As Long, x As Long
Dim matches As Variant, match As Variant
Dim Reg_Exp As Object
Dim rValue As String
Set Reg_Exp = CreateObject("vbscript.regexp")
Reg_Exp.Pattern = "([\s\S]+?):\s*([\s\S]+?)\s*-\s*([A-z]+)\s*,\s*([0-9]{2}\/[0-9]{2}\/[0-9]{4})\b"
Set ws = Sheet2
lastRow = ws.Range("C" & Rows.Count).End(xlUp).Row
For x = 1 To lastRow
Set matches = Reg_Exp.Execute(CStr(ws.Range("C" & x).Value))
If matches.Count > 0 Then
For Each match In matches
ws.Range("A" & x).Value = match.SubMatches(3) & match.SubMatches(1)
ws.Range("B" & x).Value = match.SubMatches(3)
ws.Range("C" & x).Value = match.SubMatches(1)
Next match
End If
Next x
End Sub
You have provided an ambiguous date. 02/04/2018, depending on your locale, could be either 04-Feb-2018 or 02-Apr-2018.
Exactly how to fix your problem depends on your locale settings.
However, what you can do is create an unambiguous date by extracting separately the month, day and year, and creating a date from that.
Change your regex pattern to split out date parts separately.
([\s\S]+?):\s*([\s\S]+?)\s*-\s*([A-z]+)\s*,\s*([0-9]{2})\/([0-9]{2})\/([0-9]{4})\b
Then add into your code lines like this:
Dim DT as Date
... your regex stuff ...
With mc(0)
'DT = DateSerial(.SubMatches(5), .SubMatches(3), .SubMatches(4))
' or
'DT = DateSerial(.SubMatches(5), .SubMatches(4), .SubMatches(3))
End With
Choose the appropriate line depending on whether the date in your original data is MDY or DMY format.
You can then write DT to the appropriate part of your worksheet, and format the cell as you wish.
Well I have done a lot of research and found a lot of relevant questions and answers but couldn't quite figure out how to cater that information to my specific need.
I am working on a project to create a macro that will correct mistakes and fill in information commonly found in product catalogs that I work with.
One thing I am trying to accomplish is to give the value "unassigned" to each blank cell in a row that is marked "Y" in column B.
I've found out how to change every cell in those particular rows and have it adjust dynamically to the number of rows. What I can't figure out is how to do the same for the number of columns. In my code below everything between columns B and S is included. Column B will always be in the same spot but column S will not always be the last column.
Dim tracked As String
Dim endCell As Range
Dim endRow As Long
Dim endColumn As Long
Dim start As Long
endRow = ActiveSheet.Range("D2").End(xlDown).Row
endColumn = ActiveSheet.Range("A1").End(xlToRight).Column
Let tracked = "B2:" & "B" & endRow
Set trackItem = ActiveSheet.Range(tracked)
For Each y In trackItem
If Left(y.Value, 1) = "Y" Then
'start = y.Row
'Set endCell = ActiveSheet.Cells(endColumn, start)
ActiveSheet.Range("B" & y.Row & ":" & "S" & endColumn).Value = "Unassigned"
End If
Next y
I included some code that I've left commented out so you can see what I've tried.
So, I can successfully change the value of all cells within that range but I need to know how to do it with a range where the number of columns will not always be the same. In addition, I want to select the blank cells only within this range and assign them a value. I imagine this will need to be done row by row as the correct criteria will not always be together.
I'm surprised more people don't use 'UsedRange' when there is a need to loop through all the cells that have data on a sheet. (Just yesterday someone was complaining that it takes too long to loop through all 17,179,869,184 cells on a worksheet...)
This example lists & counts the "used" range, and will easily adapt to your needs.
Sub List_Used_Cells()
Dim c As Range, x As Long
For Each c In ActiveSheet.UsedRange.Cells
Debug.Print c.Address & " ";
x = x + 1
Next c
Debug.Print
Debug.Print " -> " & x & " Cells in Range '" & ActiveSheet.UsedRange.Address & "' are considered 'used'."
End Sub
I have a long list of data on an excel table. This data includes detail information of each order in several rows. There is a column shows the status of each row. Also, I have a dashboard which just lists out the order names. I want the users to be able to see a short statistical info of each book as a comment or when they mouse over the cell, if possible or as a cell data. The info could be something like underneath sample in 3 or 4 row. (The number of items is the count of rows with the same status)
5 issued item
3 shortage items
2 Done items
X other
If you just give me the general idea it would be great.
I think I have to use a collection procedure, something like "scripting dictionary" but I have no experience using them. I know how to do that by putting a case statement after if clause inside a loop, but I am looking for a smarter way. you can find some pictures and a sample data below: sample pictures
For the record, I came to this answer from one of friends in MrExcel froum. Hope you find it usefull.
The just difference is, I was looking for a momentum reply just for an active cell, but this code, provide all the information for all the order names as a comment. but it is very easy to adjust!
Sub UpdateComments()
Dim c As Variant, strComment As String
Dim intISSUED As Integer, intSHORTAGE As Integer
Dim tblDATA As ListObject, tblDASH As ListObject
Set tblDATA = Application.Range("TBL.data").ListObject 'adjust Table Name
Set tblDASH = Application.Range("TBL.dash").ListObject 'adjust Table Name
For Each c In tblDASH.ListColumns("W/B").DataBodyRange
strComment = ""
intISSUED = Application.CountIfs(tblDATA.ListColumns("Work Book").DataBodyRange, c, tblDATA.ListColumns("Stage").DataBodyRange, "Issued")
strComment = strComment & Chr(10) & "Issued: " & intISSUED
intSHORTAGE = Application.CountIfs(tblDATA.ListColumns("Work Book").DataBodyRange, c,tblDATA.ListColumns("Stage").DataBodyRange, "Shortage")
strComment = strComment & Chr(10) & "Shortage: " & intSHORTAGE
' ADDITIONAL 'STAGES' HERE
' OR put 'stages' in array to condense code
With Sheets(tblDASH.Parent.Name).Range(c.Address)
If .Comment Is Nothing Then
.AddComment
.Comment.Visible = False
End If
.Comment.Text Text:=Mid(strComment, 2)
End With
Next c
End Sub
Hello stackoverflow community,
I must confess I primarily code within MS Access and have very limited experience of MS Excel VBA.
My current objective is this, I have an expense report being sent to me with deductions in another countries currency, this report has many columns with different account names that may be populated or may be null.
I currently have a Macro that will open an input box and ask for the HostCurrency/USD Exchange rate, my next step will be to start at on the first record (Row 14; Column A-K contains personal info regarding the deduction) then skip to the first deduction account (deduction accounts start at column L and span to column DG) checking if each cell is null, if it is then keep moving right, if it contains a value then I want to multiply that value by my FX rate variable that was entered in the input box, and update the cell with the converion. Once the last column (DG) has been executed I want to move to the next row (row 15) and start the process again all the way until the "LastRow" in my "Used Range".
I greatly appreciate any feedback, explanations, or links that may point me towards my goal. Thank you in advance for taking the time to read though this!
First off, you really should attempt to write the code yourself and post what you have so someone can try to point you in the right direction. If your range is going to be static this is a very easy problem. You can try something along the lines of:
Sub calcRate(rate As Double, lastrow As Integer)
Dim rng As Range
Set rng = Range("L14" & ":DG" & lastrow)
Dim c As Variant
For Each c In rng
If c.Value <> "" Then
c.Value = c.Value * rate
End If
Next
End Sub
This code will step through each cell in the given range and apply the code without the need for multiple loops. Now you can call the calcRate sub from your form where you input the rate and lastrow .
This will do it without looping.
Sub fooooo()
Dim rng As Range
Dim mlt As Double
Dim lstRow As Long
mlt = InputBox("Rate")
With ActiveSheet
lstRow = .Cells(.Rows.Count, 1).End(xlUp).Row
Set rng = .Range(.Cells(14, 12), Cells(lstRow, 111))
rng.Value = .Evaluate("IF(" & rng.Address & " <>""""," & rng.Address & "*" & mlt & ","""")")
End With
End Sub
If your sheet is static you can replace ActiveSheet with WorkSheets("YourSheetName"). Change "YourSheetName" to the name of the sheet.
I am trying to create a VBA macro which will search the rows on the basis of the following criteria:
First it will look for a name specified in the macro in the name column.
If the name is found it will proceed to check the 'submitted' column and check whether the submitted date is between a weekly date. (like if the date is between 2/23/2015-2/27/2015).
If the date lies between the specified dates then the macro will group the activities based on their names and add the number of hours based on the values in the hours tab.
This whole data is finally to be copied and pasted into another worksheet in the same workbook.
So far I have only been able to get to searching for the names part and being a newbie to VBA macro I have absolutely no idea of how to proceed.
So far I have done pathetically since yesterday to come up with a solution. Please help. I am attaching my code, though I wonder if its of any use
Sub Demo()
Dim rngCell As Range
Dim lngLstRow As Long
Dim strFruit() As String
Dim intFruitMax As Integer
intFruitMax = 3
ReDim strFruit(1 To intFruitMax)
strFruit(1) = "A"
strFruit(2) = "B"
strFruit(3) = "C"
lngLstRow = ActiveSheet.UsedRange.Rows.Count
For Each rngCell In Range("J2:J" & lngLstRow)
For i = 1 To intFruitMax
If strFruit(i) = rngCell.Value Then
rngCell.EntireRow.Copy
Sheets("Inventory").Select
Range("A65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial xlPasteValues
Sheets("Sheet1").Select
End If
Next i
Next
End Sub
I believe the points below will allow you to progress although it cannot be a full answer because you do not give enough information for that. Warning: I do not explain my macros fully. Look up Help for the statements I use and try to work out why they have the effect they do. Come back with questions as necessary but the more you can work out for yourself, the more you will develop your VBA knowledge.
lngLstRow = ActiveSheet.UsedRange.Rows.Count
It is best to avoid ActiveSheet and UsedRange unless you know exactly what you are doing.
If you use the active worksheet, you are relying on the user having the correct worksheet active when they start the macro. You may one day want to allow the user to select which worksheet is the target for a macro but I doubt that is the case here. If possible be explicit. For example:
With Worksheets("New Data")
.Range("A1").Values = "Date"
End With
Above I explicit specify the worksheet I wish to use. It does not matter what worksheet is active when the user starts the macro. If I come back to the macro after six months, I do not have to remember which of the 20 worksheets it operates on.
Excel’s definition of UsedRange does not always mean what the programmer thinks its means. Do not use it until you have tried it out on a variety of test worksheets. In particular, try (1) formatting cells outside the range with values and (2) leaving the left columns and top rows unused. Try Debug.Print .UsedRange.Address. You will be surprised at some of the ranges you get.
Create a new workbook. Place values in E4, C7 and B10. Merge cells F12 and F13 and place a value in the merged area. It does not matter what those values are.
Copy this macro to a module and run it:
Option Explicit
Sub Test1()
Dim ColFinal As Long
Dim RowFinal As Long
Dim RowFinalC As Long
With Sheets("Sheet1")
RowFinal = .Cells.Find(What:="*", After:=.Range("A1"), LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
ColFinal = .Cells.Find(What:="*", After:=.Range("A1"), LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
RowFinalC = .Cells(Rows.Count, "C").End(xlUp).Row
End With
Debug.Print "ColFinal" = ColFinal
Debug.Print "RowFinal" = RowFinal
Debug.Print "RowFinalC" = RowFinalC
End Sub
The output will be:
ColFinal=5
RowFinal=12
RowFinalC=7
In most cases, Find is the best way of locating the last row and/or column of a worksheet. What:="*"means look for anything. Notice that I have different values for SearchOrder. It does not matter that the worksheet is not rectangular; the last row and the last column do not have to be the same cell.
However, there is no method of finding the last row or column that works in every situation. Find has not “seen” the merged cell when searching by column. (Warning, I am using an old version of Excel and this may have been fixed in your version.)
You want the last used cell in column J. My technique for finding the last row in column C may be the easiest technique for you.
Consider:
intFruitMax = 3
ReDim strFruit(1 To intFruitMax)
strFruit(1) = "A"
strFruit(2) = "B"
strFruit(3) = "C"
For i = 1 To intFruitMax
Next i
There is nothing wrong with your code but this macro shows a different approach that may be more convenient:
Sub Test2()
Dim Fruit() As Variant
Dim InxFruit As Long
Fruit = Array("A", "B", "C")
For InxFruit = LBound(Fruit) To UBound(Fruit)
Debug.Print Fruit(InxFruit)
Next
End Sub
It is becoming uncommon to have a three letter prefix specifying the type of a variable. As someone asked: “Is strFruit really more useful than Fruit?”. Avoid variable names like i. It probably does not matter with such a small macro but I have tried to decipher macros with a bunch of meaningless names and can assure you it is a nightmare. InxFruit says this is an index into array Fruit. I can look at macros I wrote years ago and immediately know what all the variables are.
LBound(Fruit) will always be zero if you use Array. Note also that Fruit has to be of type Variant. The advantage is that when you want to add fruits D and E, you just change to:
Fruit = Array("A", "B", "C", "D", "E")
If the name is found it will proceed to check the 'submitted' column and check whether the submitted date is between a weekly date. (like if the date is between 2/23/2015-2/27/2015).
Your technique for finding rows for interesting fruit is not the best technique but I think it is good enough. I am giving you enough to think about without discussing other approaches.
I am guessing you want to know if the date is between Monday and Friday of the current week.
Now() gives you the current date and time. The next macro shows how to calculate the Monday and Friday for any day of a week. If you chose to copy this technique, please document it properly for the benefit of the poor sod who has to update your macro in a year’s time. This macro is all clever arithmetic with functions and constants. I do not like clever code, unless it is properly documented, because it is usually the programmer showing off rather than solving the problem using the simplest method.
Sub Test3()
Dim Friday As Date
Dim InxDate As Long
Dim Monday As Date
Dim TestDates() As Variant
Dim Today As Date
Dim TodayDoW As Long
TestDates = Array(DateSerial(2015, 2, 22), DateSerial(2015, 2, 23), _
DateSerial(2015, 2, 24), DateSerial(2015, 2, 25), _
DateSerial(2015, 2, 26), DateSerial(2015, 2, 27), _
DateSerial(2015, 2, 28), Now())
For InxDate = 0 To UBound(TestDates)
Today = TestDates(InxDate)
TodayDoW = Weekday(Today)
Monday = DateSerial(Year(Today), Month(Today), Day(Today) + vbMonday - TodayDoW)
Friday = DateSerial(Year(Today), Month(Today), Day(Today) + vbFriday - TodayDoW)
Debug.Print "Today=" & Format(Today, "ddd d mmm yy") & _
" Monday=" & Format(Monday, "ddd d mmm yy") & _
" Friday=" & Format(Friday, "ddd d mmm yy")
Next
End Sub
Note that Excel holds dates as numbers so you can write If Monday <= TransDate And TransDate <= Friday Then.
Your technique for moving data from one worksheet to another is clumsy. This macro moves every row with “A”, “a”, “B”, “b”, “C” or “c” in column J from worksheet “Sheet2” to “Sheet3”. I believe you will agree the innermost loop in clearer than yours.
Sub Test4()
' I assume row 1 contains column headers and is not to be copied
' to the new worksheet. Constants are a good way of making such
' assumptions explicit and easy to change if for example to add
' a second header row
Const RowSht2DataFirst As Long = 2 ' This only applies to Sheet2
Const ColFruit As Long = 10 ' This applies to both sheets
Dim Fruit() As Variant
Dim FruitCrnt As String
Dim InxFruit As Long
Dim RowSht2Crnt As Long
Dim RowSht2Last As Long
Dim RowSht3Next As Long
Dim Wsht2 As Worksheet
Dim Wsht3 As Worksheet
' It takes VBA some time to evaluate Worksheets("Sheet2") and
' Worksheets("Sheet3"). This means it only has to do it once.
Set Wsht2 = Worksheets("Sheet2")
Set Wsht3 = Worksheets("Sheet3")
' BTW Please don't use the default names for a real workbook.
' It is so much easier to understand code with meaingful names
Fruit = Array("A", "B", "C")
With Wsht3
' Place new rows under any existing ones.
RowSht3Next = .Cells(Rows.Count, ColFruit).End(xlUp).Row + 1
End With
With Wsht2
RowSht2Last = .Cells(Rows.Count, ColFruit).End(xlUp).Row
For RowSht2Crnt = RowSht2DataFirst To RowSht2Last
FruitCrnt = UCase(.Cells(RowSht2Crnt, ColFruit).Value)
For InxFruit = LBound(Fruit) To UBound(Fruit)
If Fruit(InxFruit) = FruitCrnt Then
.Rows(RowSht2Crnt).Copy Destination:=Wsht3.Cells(RowSht3Next, 1)
RowSht3Next = RowSht3Next + 1
Exit For
End If ' Match on fruit
Next InxFruit
Next RowSht2Crnt
End With ' Wsht3
End Sub