I would like to get the last modified date of a given list of files that I need to enter in column A of Excel . How can I fix this ? For each file , I want to get the last modified date. Unfortunately I haven't many skills in VBA .
That's easy! You can apply FileDateTime ( file_path ). If you have file patch & name list in column A, and this macro will return the date & time of when a file was created or last modified in column B.
Sub LastFileDateTime()
CNT = Range("A65536").End(xlUp).Row
For i = 1 To CNT
Cells(i, "B").Value = FileDateTime(Cells(i, "A"))
'FileDateTime("D:\QueryTable.xlsm")
Next
End Sub
You have to replace "A" and "B" with the number for the column, and you can simplify if you know how many rows you have. I was able to get it to work with the code below.
Sub LastFileDateTime()
For i = 2 To 45
Cells(i, 2).Value = FileDateTime(Cells(i, 1))
'FileDateTime("D:\QueryTable.xlsm")
Next
End Sub
Related
I am writing a VBA code in my excel. I have employees date of birth on Row F. Now, using VBA, I want phrase called "Happy Birthday" on column G for those employees who have birthdays. My table starts from row 6 to row 50. I wrote the following code but it always gives error in Month(Range("f" & y)). The month function gives me error. If, for example, I only write Range("f" & y), it will work fine. This means the Date of birth on column F isn't being recognized as DATE in my VBA (they are in date format in excel). There is a mismatch for sure. Can someone please help me how to fix this issue (using for next function as shown below)?>
Sheets("Employees").Select
For y = 6 To 50
If Month(VBA.Date) = Month(Range("f" & y)) Then
Range("g" & y).Value = "HBD"
Else
Range("g" & y).Value = "No hbd"
End If
Next y
Note: A). I am looking at the month of date of birth only for wishing happy birthday and I am not looking at day. B). I want message called HBD or NO HBD to be posted on column G for each employee based on their DOB given on Column F .
With a formula I think you should be able to do it with =IF(MONTH(TODAY())=MONTH(F6),"HBD","No HBD").
For a VBA solution use:
Sub Test()
Dim y As Long
With ThisWorkbook.Worksheets("Employees")
For y = 6 To .Cells(.Rows.Count, 6).End(xlUp).Row
If Month(Date) = Month(.Cells(y, 6)) Then
.Cells(y, 7) = "HBD"
Else
.Cells(y, 7) = "No HBD"
End If
Next y
End With
End Sub
NB: Cells(Row, Column) is used in place of Range - easier for referencing a single cell using row/column numbers.
Column 'P' ("P6:P3000") holds a value as such "EMPLOYEE_CONTRACT_STATUS_Closed". I am trying to pull the "Closed" (could also be "Open") portion out of the cell into column 'Q' or just replace the existing column 'P' value with the last text after the delimiter ("_")... "EMPLOYEE_CONTRACT_STATUS_Closed" --> "Closed" or "Open." This creates these steps:
Create new column Q
Insert new value in column header
Perform function in 'P' to either replace values or dump into column 'Q' ("Q6:Q3000")
Below I have what I have so far --> Code to create column and to call a function code to pull the last text after last delimiter... this is a part of an automated process so the goal is not to touch or manipulate any of the
cell values. I know there is possibly for a Subprocess to perform this but I cannot figure it out and keep scratching my head. This is my first time on the forum and for someone to supply a fixed code but also EXPLAIN the syntax behind it would be great because I am pretty experience with VBA, but have never ran into this process. THANKS ^_^
& 2. Creating new column and changing the header name:
Sub ContractStatus_Change()
Application.ScreenUpdating = False
Workbooks("DIV_EIB_Tool.xlsm").Worksheets("EIBMaintainEmployeeContractsW31").Range("Q5") _
.EntireColumn.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
Worksheets("EIBMaintainEmployeeContractsW31").Range("Q5").Value = "Contract Status"
Worksheets("EIBMaintainEmployeeContractsW31").Range("Q6:Q3000").NumberFormat = "General"
Application.ScreenUpdating = True
End Sub
My function to pull last text out from disclosed value:
Function RightWord(r As Range) As Variant
Dim s As String
s = Trim(r.Value)
RightWord = Mid(s, InStrRev(s, "_") + 1)
End Function
I have not run into an error yet, just do not know how to piece this together, under assumption I can probably run this all through one sub process but I am having a massive brain fart.
Try this code
Sub Test()
Dim a, i&
With Worksheets("EIBMaintainEmployeeContractsW31")
.Columns("Q").Insert
a = .Range("P6:P" & .Cells(Rows.Count, "P").End(xlUp).Row).Resize(, 2).Value
For i = LBound(a) To UBound(a)
If InStr(a(i, 1), "_") Then
a(i, 2) = Split(a(i, 1), "_")(UBound(Split(a(i, 1), "_")))
End If
Next i
With .Range("Q5")
.Value = "Contract Status"
.Offset(1, -1).Resize(UBound(a, 1), UBound(a, 2)).Value = a
End With
End With
End Sub
I started the code by dealing with the sheet EIBMaintainEmployeeContractsW31 so between With and End With you will notice some lines start with dot which refers to this worksheet. Then insert a column before column Q and stored the required range which is P6 to P & last row into an array (arrays are faster)
After that looping the array which holds two columns (one for the raw data and the other for the required output). Make sure of underscore existence using InSstr function then if it exists store into the second column the last part of the split output based on the underscore.
Finally populating the array into the worksheet.
Hope that explanation helps you.
Hello I'm trying to delete all the rows where in column B the members value is over 1000.
I tried this step by step and tried first getting rid of all the unecessary data from B cells and leave just the line with the members.
I noticed there are 5 lines and the members line is the 6'th one. I searched for hours and I still don't get it HOW TO DELETE THE FIRST 5 LINES. Could you please offer me a hand of help? Im sure its soo easy but I cant find it.
I have this:
Option Explicit
Sub Delete5TextLines()
Dim c As Range, s
Application.ScreenUpdating = False
For Each c In Range("B1", Range("B" & Rows.Count).End(xlUp))
**********
Next c
Application.ScreenUpdating = True
End Sub
this is the .csv file:
http://we.tl/vNcyfg9Wus
Alright, this is not very elegant, but the first thing that I came up with, that kinda works.
use this formula to delete the last word in your bulk of text ("members")
Assuming your text is in A1:
=LEFT(A1,FIND("|",SUBSTITUTE(A1," ","|",LEN(A1)-LEN(SUBSTITUTE(A1," ",""))))-1)
This formula gets you the last word of a text, in this case the number of members (because we deleted the word "members)
Assuming you put the formula above in A2
=IF(ISERR(FIND(" ",A2)),"",RIGHT(A2,LEN(A2)-FIND("*",SUBSTITUTE(A2," ","*",LEN(A2)-LEN(SUBSTITUTE(A2," ",""))))))
Now you should have extracted the number of members. If this value is <5000 you can delete the row with a vba loop that should look like this:
Sub deleteRowsAfterMembers
Dim i as Integer
i = ThisWorkbook.Sheets(1).Rows.Count
While i > 0 Do
If (CellWithMemberCount).Value < 5000 Then
ThisWorkbook.Sheets(1).Rows(i).Delete
End If
i = i-1
Loop
End Sub
That'll (hopefully) do it.
Whenever you delete entire rows using a loop, you should start at the bottom of the range and work the loop upwards.
EDIT#1:
Assuming that there are at least five lines within a cell and the lines are separated by Chr(10) then this will remove the first 5 lines:
Sub marine()
ary = Split(ActiveCell.Value, Chr(10))
t = ""
For i = 5 To UBound(ary)
t = t & Chr(10) & ary(i)
Next i
If Len(t) > 1 Then
t = Mid(t, 2)
Else
t = ""
End If
ActiveCell.Value = t
End Sub
I'm trying to get excel to put together a series of text strings that haven't been formatted systematically, so that they end up split into different rows on a data sheet.
I'm aware this might've been solved elsewhere so sorry for that but I'm struggling to describe the issue, and I can't post images on it but basically it's
Column 1 with a list of the entries, and
Column 2 with text strings that are spread over 2 or more rows
Is it possible to write some kind of formula or macro that would be able to check the first column and then stitch together all entries in the second column going down until it found a new entry in the first column? I've got a feeling it might be possible using some sort of loop thing with index functions, but I've no idea where to start even.
Thanks,
Mike
Mike give this a ty
Sub appendValues()
'The sub is designed to loop through code and when ever there is a null value and column a it will take the value of what is in column B and appended to the row above it and delete the row.
Dim row As Integer
row = 1
'This code starts with row one but this can be changed at will.
Do Until ThisWorkbook.Sheets("sheet1").Cells(row, 2).Value = ""
'loop statement is designed to continue to Loop until there is a null value inside of you the value in the second column.
If ThisWorkbook.Sheets("sheet1").Cells(row, 1).Value = "" Then
ThisWorkbook.Sheets("sheet1").Cells(row - 1, 2).Value = ThisWorkbook.Sheets("sheet1").Cells(row - 1, 2).Value & ThisWorkbook.Sheets("sheet1").Cells(row, 2).Value
Rows(row).Delete
Else
'else statement is needed because there is an implied looping by decreasing the total number of rows after the delete.
row = row + 1
End If
Loop
End Sub
Sub appendValues()
'The sub is designed to loop through code and when ever there is a null value and column a it will take the value of what is in column B and appended to the row above it and delete the row.
Dim row As Integer
row = 1
'This code starts with row one but this can be changed at will.
Do Until ThisWorkbook.Sheets("sheet1").Cells(row, 2).Value = ""
'loop statement is designed to continue to Loop until there is a null value inside of you the value in the second column.
If ThisWorkbook.Sheets("sheet1").Cells(row, 1).Value = "" Then
ThisWorkbook.Sheets("sheet1").Cells(row - 1, 2).Value = ThisWorkbook.Sheets("sheet1").Cells(row - 1, 2).Value & ThisWorkbook.Sheets("sheet1").Cells(row, 2).Value
Rows(row).Delete
Else
'else statement is needed because there is an implied looping by decreasing the total number of rows after the delete.
row = row + 1
End If
Loop
End Sub
I'm relatively new to VBA and I'm trying to write a macro that will compare two columns of data (first and last names). While traversing the column, any time first name = last name (ie. they're both blank or say UNKNOWN) I want the cell in the 9th column to be cleared and the cell in the 10th column to get the value UNKNOWN.
As of now, the code correctly recognizes any time when the first and last name are identical. My problem is that any time first name is a sub-string of any last name (ie. cell I2=David J2=Jones , I3=Joseph J3=Davidson) David gets compared with Davidson and is subsequently erased.
I've spent a while looking for similar problems and I haven't been able to adapt anything to my problem thus far. Thanks in advance for any help.
Sub compare_cols()
Dim Report As Worksheet
Dim i As Integer, j As Integer
Dim lastRow As Integer
Set Report = Excel.ActiveSheet
lastRow = Report.UsedRange.Rows.count
Application.ScreenUpdating = False
For i = 1 To lastRow ' This will find all identical pairs of cells in I,J (blank, blank) or (unknown, unknown). I stays blank, J gets UNKNOWN
For j = 1 To lastRow ' I think its currently erasing any matches (ex. if someones first name is James, it will get erased if there is a last name jameson)
If InStr(1, Report.Cells(j, 10).Value, Report.Cells(i, 9).Value, vbTextCompare) > 0 Then
Report.Cells(i, 9).Value = ""
Report.Cells(i, 10).Value = "UNKNOWN"
Exit For
Else
End If
Next j
Next i
Application.ScreenUpdating = True
End Sub
Unlike some other languages, you can compare strings in vba just using the "=" sign and that will find exact matches, which is what it appears you are looking for. Try
if Report.Cells(j, 10) = Report.Cells(i, 9) etc.