I am attempting to learn some vba programming for excel, Long story short
I have a machine using an allen bradley plc, I have created a program in the plc to record hourly run statitistics, I have managed to get these to update live into an excel sheet, it uploads each hour for 24 hours. The machine runs on 3 shifts 6am to 2pm, 2pm to 10 pm, 10 pm to 6 am. In the factory we class each day as 6am to 6am.
I have written the following code, which copies the values from the plc and pastes them to the matching date, cell "c10" contains =today() then on sheet 2 it will paste the values to a calender under the matching date.
this is now working fine however i would like to change it so that under each date it contains 6am to 6 am values rather than 24 hours worth.
the issue i have is that cell c10 (todays date) will update after 12am and therefore the paste destination will change.
heres my code
Private Sub work_test()
'set variables
Dim Day As Date
Dim rfound As Range
Dim frow, fcol As Integer
Dim sh1, sh2 As Worksheet
'set sheets
Set sh1 = Sheets("sheet1")
Set sh2 = Sheets("sheet2")
'sets day as current day, finds matching day in sheet2
Day = sh1.Range("c10")
Set rfound = sh2.Range("7:11").Find(Day, LookIn:=xlValues)
If Not rfound Is Nothing Then
frow = rfound.Row
fcol = rfound.Column
sh1.Range("c11:c34").Copy sh2.Cells(9, fcol)
Else
MsgBox "No match found"
End If
'runs timer
Call timer
End Sub
Sub timer()
'repeats cell update timer
Application.OnTime Now + TimeValue("00:01:00"), "work_test"
End Sub
Hope someone can help, not looking for a complete solution, just a bit of help in the correct direction
Thanks
These are two of many ways achieving what yo want:
1.- Replace formula in C10 with this one:
= TODAY() + IF( NOW() - TODAY() < TIME(6,0,0) , -1 , 0 )
Formula above validates the time and it less that 06:00:00 then rest one to the date. Thus anything between midnight and 06 AM will be taken as the day before
2.- In your code replace this line:
Day = sh1.Range("c10")
with this:
Day = Date + IIf(Time < TimeSerial(6, 0, 0), -1, 0)
Same as in point 1 above, only that since you are using VBA there is no need to have the date as a formula in the worksheet, the date of the machine can be obtain that directly in the VBA and proceed from there.
Related
I have a requirement that once a week on a Friday I need to pull some data from workbooks generated each day of the week (Mon-Fri) into a weekly dated summary in a new workbook. The new workbook is to be a cumulative view of each week with the date auto populated on the Friday when the data is pasted into the summary sheet.
I need some pointers on how to logically work out the current date, search back to find the first file from that Monday (but include Friday's file) and then to insert the range of dates from that week into the corresponding cells next to the copied data.
I've found various posts from others looking to do a similar thing, and I've attempted to begin working on that basis to produce what I want it to do. However, I'm not trained in VBA so I am attempting everything on a 'best efforts' basis. The below is the code I have written which currently just opens up the last file in the directory. I also have a separate tab with the public holidays I want it to take into account when running the macro. Clearly there's a lot for me to do, I would be grateful for any tips and pointers on what I should try.
Sub WeeklyUpdate()
Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim lCopyLastRow As Long
Dim lDestLastRow As Long
Dim LastPreviousWorkday As Date
'date format to use and where to lookup the bank holidays
LastPreviousWorkday = Application.WorksheetFunction.WorkDay(Date, -1)
LastPreviousWorkday = Format$(LastPreviousWorkday, ("yyyy-mm-dd"))
LastPreviousWorkday = Application.WorksheetFunction.WorkDay(Date, -1, Worksheets("PublicHolidays").Range("A:A"))
'This is where I want it to opens the last 5 days of workbooks from today's date including today e.g. Monday-Friday, report is always run on a Friday
Workbooks.Open "W:\Inventory\Inventory Support\3. Reporting\Daily\Daily Fails Report\Daily Fails Report " & Format(Date, "yyyy-mm-dd") & ".xlsb"
'Set variables for copy and destination sheets
Set wsCopy = Workbooks("Daily Fails Report 2019-06-26.xlsb").Worksheets("Daily Fails Report (National)")
Set wsDest = Workbooks("Weekly Issues Summary.xlsb").Worksheets("CurrentPeriodSummary")
'Find last used row in the copy range based on data in column O
lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "O").End(xlUp).Row
'Find first blank row in the destination range based on data in column B
'Offset property moves down 1 row to exclude headers
lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "B").End(xlUp).Offset(1).Row
'Copy data range excluding the grand total which is always the last row (so use -1 to select the last row above it) & Paste Data into Summary
wsCopy.Range("O9:Q" & lCopyLastRow - 1).Copy _
wsDest.Range("B" & lDestLastRow)
End Sub
I expect the output of the above to update my summary workbook with five lines of data per week with a date against each one that corresponds to the date in the name of the file.
I need some pointers on how to logically work out the current date, search back to find the first file from that Monday (but include Friday's file) and then to insert the range of dates from that week into the corresponding cells next to the copied data.
The following function outputs the date range (as an array), from Today going back to the previous Monday.
Option Explicit
Function dateStuff() As Date()
Dim lastMonday As Date
Dim arrDates() As Date
Dim I As Long
lastMonday = Date - Weekday(Date, vbMonday) + 1
ReDim arrDates(0 To Date - lastMonday)
For I = 0 To UBound(arrDates)
arrDates(I) = lastMonday + I
Next I
dateStuff = arrDates
End Function
You can then use the output of this function to create the names for the corresponding workbooks.
If I understand what you are doing correctly, there shouldn't be a need to exclude holidays from this list. Since you won't have a workbook generated for a holiday, just test to see if the workbook exists when you are trying to obtain the data.
Here's a routine to put the generated date range into some cell. You can work out how to change rOutput to reflect your real target cell. This Sub depends on the above Function:
Sub insertDateRange()
Dim dateRange() As Date
Dim rOutput As Range
Set rOutput = Worksheets("sheet1").Range("B1")
dateRange = dateStuff
rOutput = dateRange(0) & " - " & dateRange(UBound(dateRange))
End Sub
Run Today 27-Jun-2019 the macro will output 6/24/2019 - 6/27/2019
but you can use the VBA Format function to change the output format of the dates if you desire.
EDIT:
So far as opening the workbooks and processing them, it's just a matter of iterating through the output of the dateStuff function to generate your workbook paths. eg:
'This is where I want it to opens the last 5 days of workbooks from today's date including today e.g. Monday-Friday, report is always run on a Friday
Dim wbDates() As Date, Idx As Long
Dim wbDaily As Workbook, wbPath As String
wbDates = dateStuff 'wbDates now contains an array of the relevant dates
'This will open the workbooks one at a time and you can process them as you wish
'You should refer to this daily workbook as `wbDaily` or some other variable of your choice
For Idx = LBound(wbDates) To UBound(wbDates)
wbPath = "W:\Inventory\Inventory Support\3. Reporting\Daily\Daily Fails Report\Daily Fails Report " & Format(wbDates(Idx), "yyyy-mm-dd") & ".xlsb"
If Len(Dir(wbPath)) > 0 Then 'workbook exists
Set wbDaily = Workbooks.Open(wbPath)
'your code
'.....
wbDaily.Close
End If
Next Idx
I have a workbook that is used to schedule the next upcoming task on a job. each row has 28 cells, each cell represents a day of the week within the 4 weeks lookahead. I made a formula to check the date of the cell with the start and end date of the task and fill the cell accordingly.
Here is the formula:
=IFERROR(IF(AND(ISNUMBER(SEARCH("Delivery",$D16)),VALUE(F$10)=VALUE('Calculation
New'!$AO53)),"D",IF(AND(ISNUMBER(SEARCH('Calculation
New'!$BH$13,$AJ16)),VALUE(F$10)>=VALUE('Calculation
New'!$AO53),VALUE(F$10)<=VALUE('Calculation
New'!$AP53)),"N",IF(AND(ISNUMBER(SEARCH('Calculation
New'!$BH$12,$AJ16)),VALUE(F$10)>=VALUE('Calculation
New'!$AO53),VALUE(F$10)<=VALUE('Calculation
New'!$AP53)),"E",IF(AND(VALUE('Calculation
New'!$AO53)=VALUE('Calculation New'!$AP53),F$10='Calculation
New'!$AO53,NOT(ISNUMBER(SEARCH('Calculation
New'!$BH$9,$D16)))),"SF",IF(AND(ISNUMBER(SEARCH('Calculation
New'!$BH$9,$D16)),VALUE(F$10)>=VALUE('Calculation
New'!$AO53),VALUE(F$10)<=VALUE('Calculation
New'!$AP53)),"I",IF(AND(VALUE(F$10)>VALUE('Calculation
New'!$AO53),VALUE(F$10)<VALUE('Calculation
New'!$AP53)),"X",IF(VALUE(F$10)=VALUE('Calculation
New'!$AO53),"S",IF(VALUE(F$10)=VALUE('Calculation
New'!$AP53),"F","")))))))),"")
a few things to that formula:
D16:D85 on the sheet "SIS" is the Task description where to look for certain words
BH9 on sheet "Calculation New" contains a word to compare to. The range of words is BH3:BH13
F10:AF10 on the sheet "SIS" contains the date for the cells below of the day of the week
AO53:AO122 on sheet "Calculation New" contains the start date of a task
AP53:AP122 on sheet "Calculation New" contains the End date of a task
currently, I got 70 Rows times 28 cells and each cell has this formula in it. Now I want to rather use a VBA code do the same thing, but I am having a hard time to get started. I am not very experienced with VBA. I researched in regards to nesting For each loop but so far I am not succeeding.
I would appreciate any help I can get.
Thank you in advance
Dan
here is the code I have written so far not complete but I am stuck and need some advice
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim SDate As Range
Dim EDate As Range
Dim WDate As Range
Set SDate = Worksheets("Calculation New").Range("SDate")
Set EDate = Worksheets("Calculation New").Range("EDate")
Set WDate = Worksheets("Calculation New").Range("WDate")
For SDate = 1 To Worksheets("Calculation New").Range("SDate").End(xlDown) 'lenght of range varies
'For WDate = 1 To 28 ' length is always same
'If cell = WDate Then 'i want to compare each cell of WDate with the start date
'cell = "X"
'Next
Next
End Sub
To get you started with VBA, you might want to start here. There's a lot of questionable sites offering VBA code but this is directly from Microsoft and covers the basics. Happy coding!
https://learn.microsoft.com/en-us/office/vba/library-reference/concepts/getting-started-with-vba-in-office
For loops can be tricky - generally you can start with an array saying r = ActiveSheet.UsedRange and loop through it
Sub nestedLoop()
r = ActiveSheet.UsedRange
For i = LBound(r) To UBound(r)
For j = LBound(r, 2) To UBound(r, 2)
'evaluate r(i,j) do something
'Debug.print r(i,j)
Next j
Next i
End Sub
I have a production workbook that has a tab for each month of the year and a YTD summary tab. Each monthly worksheet has the rows that show the different events or actions that make up a workday and the columns have the date as the header row. We do not work on Saturday or Sunday but those days appear on each of the spreadsheets. I am wanting to know how can i create a macro or VBA code to be able to automatically hide columns if the cell in that columns contains Sat or Sun. As there are multiple Saturdays and Sundays in a month it would hide multiple columns on each spreadsheet. Row 34 is the day of wek on each of the spreadsheets, utilizing a three digit day of week - Mon, Tue, Wed, etc, so i need something that says if that cell is Sat or Sun - hide that column and my columns go from B to AG. We have one of these spreadsheets for each of our over 50 workers so I could go in and manually hide them but that would take a lot of time and I know that there is a more efficient solution.
Thanks
I'm assuming you know how to set up and run VBA code as a macro? If not, see this: http://office.microsoft.com/en-us/excel-help/create-or-delete-a-macro-HP010342374.aspx#BMcreatemacrovba
Try this for the code.
Sub HideWeekends()
Dim i as integer
Dim sht as Worksheet
For each sht in ActiveWorkbook
For i = 1 to 31
If sht.Cells(34,i) = "Sat" Or "Sun" then
sht.Cells(34,1).EntireColumn.Hidden = True
End if
Next
Next
End Sub
You will have to modify this to match your spreadsheet. If the first day of the month is actually in column C instead of column A, then change
sht.Cells(34,i)
to
sht.Cells(34,i+2)
and so on.
I'm also doing this on a computer without excel, so let me know how that works and I can work with you!
Tested this based on your description above. Should work as expected.
Sub Hide_Columns_Based_On_Criteria()
Dim iCntr As Long, WS_Count As Integer, I As Integer
WS_Count = ActiveWorkbook.Worksheets.Count
For I = 1 To WS_Count
ActiveWorkbook.Worksheets(I).Select
For iCntr = 2 To 33 Step 1
If Cells(34, iCntr) = "Sat" Then
Columns(iCntr).EntireColumn.Hidden = True
End If
If Cells(34, iCntr) = "Sun" Then
Columns(iCntr).EntireColumn.Hidden = True
End If
Next iCntr
Next I
End Sub
You can make adjustments to iCntr if the column range changes from B to AG
For iCntr = 2 To 33 Step 1
I am creating a spreadsheet and would like to have rows drop off automatically at a certain age. Is there a way to do this?
My company submits engineering requests to our NY office, and I have created a job tracker to monitor the time from submittal to receipt of plans. My boss would like it if I can figure out how to make the data rows drop off after a certain time period. I've gotten all the formulas in for day counts and auto-updating with addition of new jobs, but I don't know how to go about this task.
Thank you for any input!
Something like the code below should do the trick. In this example I am starting from row two and checking a date in column F to see if this is greater than the defined interval days old (21 here), you can change the initialisation of these variables as you require:
Sub delete_old()
Dim rowDate
Dim curDate
Dim interval
Dim curAdd
Dim vCell As Range
' set interval to an appropriate no of days
interval = 21 ' can be more precise e.g. for 5 mins: (1 / 24) / 12
curDate = Now()
' assuming we want to start from row 2 and that date is in column F
Set vCell = Range("F2")
' Set Do loop to stop when an empty cell is reached.
Do Until IsEmpty(vCell)
curAdd = vCell.Address
If curDate - vCell.Value >= interval Then
vCell.EntireRow.Delete
Set vCell = Range(curAdd)
Else
Set vCell = Range(curAdd).Offset(1, 0) ' next row
End If
Loop
Set vCell = Nothing
End Sub
You will need to call this automatically upon an event such as saving or opening the workbook. Let me know if you need assistance setting this up or any clarifications on the code above.
I have an Excel report that generates everyday that have dates that differ from anywhere to three days to two due to the uneven amount of calendar days in any given month. The report, in column F looks like this below. Today's date is 07/16/13 and the process generating the report is configured to show anything greater then 180 days so that we catch the right data.
01/12/2014
01/15/2014
01/15/2014
01/12/2014
01/15/2014
I'd like to delete all rows that are not equal to 1/15/14. I don't know if there is a way to add another column with just 1/15 and then delete the rest? Any help or direction would be greatly appreciated.
We are now going into the file everyday and doing a sort by date and then delete. I'd like to automate it.
Thank you
Use a loop to iterate through the rows and remove if less than your criteria. I referenced this thread for row deletion code: Delete a row in Excel VBA.
I'm assuming your dates are in Column A and start at Row 1.
Private Sub Remove_Rows()
Dim CutoffDate As Date
CutoffDate = Date + 180
Dim ws As Worksheet
Set ws = ActiveSheet
Dim RowCounter As Integer
RowCounter = 1
Do While ws.Cells(RowCounter, 1) <> ""
If ws.Cells(RowCounter, 1) < CutoffDate Then
ws.Rows(RowCounter).Delete
End If
RowCounter = RowCounter + 1
Loop
End Sub