I am looking to take the date Friday, 08 July 2022, and convert it to 7/8/2022. I originally had a manual process to find and replace the date but if I can add it to the code it would be more efficient. The date moves to the summary tab and can be formatted there or before it moves.
Any help is appreciated, thank you!
Tea
Sub Datacleanup()
Dim c As Range, cDest As Range, lr As Long
Set cDest = Worksheets("summary").Cells(Rows.Count, "A").End(xlUp).Offset(1) 'first paste position
Set c = Worksheets("raw").Range("A1") 'start search here
lr = c.EntireColumn.Cells(Rows.Count).End(xlUp).Row 'last row of data in colA
Do While c.Row < lr
If Len(c.Value) > 0 And Application.CountA(c.EntireRow) = 1 Then
cDest.Resize(1, 3).Value = Array(c.Offset(2, 0).Value, _
c.Value, c.Offset(2, 14).Value)
Set cDest = cDest.Offset(1) ' next destination row
Set c = c.Offset(3) 'skip data block
Else
Set c = c.Offset(1) 'next row
End If
Loop
End Sub
Related
I am (still) programming in VB6, but I think this problem is not program language related.
I need to show one Picture out of 7 Pictures (named 1.jpg to 7.jpg) every calendar week, beginning with Calendar week 3, which shows picture nr.1
Example:
(year and calendar week together as 2022/03)
202203=1.jpg
202204=2.jpg
202205=3.jpg
202206=4.jpg
202207=5.jpg
202208=6.jpg
202209=7.jpg
202210=1.jpg
202211=2.jpg
etc.
How can I do this??
Also, Years can have 52 or 53 weeks, but this has to continue like above...
Appreciate any help, thank you in advance.
Here is some code that gives the results you desire. It should be fairly self-explanatory:
Option Explicit
Private Sub Test()
Dim dt As Date
Dim i As Integer
dt = DateSerial(2022, 1, 17) 'start at 3rd calendar week
For i = 1 To 100
Debug.Print Format(dt, "mm/dd/yyyy") & vbTab & Year(dt) & _
Format(ISOWeekNumber(dt), "00") & vbTab & GetPicture(dt)
dt = DateAdd("d", 1, dt)
Next
End Sub
Private Function GetPicture(ByVal dt As Date) As String
Dim dp As Integer
dp = ISOWeekNumber(dt) Mod 7 - 2
If dp <= 0 Then dp = dp + 7
GetPicture = dp & ".jpg"
End Function
Private Function ISOWeekNumber(ByVal dt As Date) As Integer
ISOWeekNumber = DatePart("ww", dt, vbMonday, vbFirstFourDays)
End Function
This produces the following results:
I have searched high and low for examples to guide me in the development of a calendar spreadsheet. The customer has very specific guidelines.
First 11 columns contain event details are setup as filters
Row 1 is currently blank, but will be used for heading
Row 2 from column K to infinity (BXY) is the year
Row 3 from column K to BXY is the month
Row 4 from column K to BXY is the day
Other notes:
Cell K6 has the Date 1-Jul-18.
All cells in row 4 continue as =K$6+1..etc.
The week is calculated with the formula:
=CONCATENATE("WEEK ", IF((IF(MONTH(K6)>=10, WEEKNUM(K6)-WEEKNUM(DATE(YEAR(K6),10,1))+1, 53-WEEKNUM(DATE(YEAR(K6)-1,10,1))+WEEKNUM(K6)))=53,1,(IF(MONTH(K6)>=10, WEEKNUM(K6)-WEEKNUM(DATE(YEAR(K6),10,1))+1,53-WEEKNUM(DATE(YEAR(K6)-1,10,1))+WEEKNUM(K6)))))
All cells in row 2 are calculated:
=YEAR($K$6)
Now to my dilemma. I am working on a userform for the user to input all data that populates the next empty row in the spreadsheet. I can not post the code that does that, as it is on a proprietary computer system. But, that code that populates the filter range A through J works fine. This code finds the next empty row:
lastRow = ws.Cells.Find(What:="*", LookIn=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
As part of the form the user inputs the start date and end date of an event. I am trying to search row 4 for the start date and end date, merge all cells between the start date and end date and insert the event title into the merged cell.
This is my code so far for searching Row 4:
For Each eventDate In .Range("K$4:BXY$4)
If IsDate(eventDate.Value) = IsDate(Me.tbStartDate.Value) Then
.Cells(lastRow, eventDate.Address(RowAbsolute:=True, ColumnAbsolute:=False)).Value = Me.tbEventName.Value
End If
Next eventDate
I am new to excel programming, and really only a hobbyist programmer. I was given this task at work and have been reading and researching examples for what I am trying to do...to no avail.
I am looking at modifying this snippet to work:
For iCounter = myLastRow To myFirstRow Step -1
If .Cells(iCounter, myCriteriaColumn).Value = myCriteria Then
.Range(.Cells(iCounter, myFirstColumn), .Cells(iCounter, myLastColumn)).Merge
Next iCounter
with this:
LastCol = sh.Cells.Find(What:="*", After:=sh.Range("A1"), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False).Column
Any assistance and guidance on how to accomplish this will be much appreciated.
v/r
Dusty
I figured it out, probably not the best solution, but it works:
lastRow = .Cells.Find(What:="*",_
LookIn:=xlFormulas,_
LookAt:=xlPart,_
SearchOrder:=xlByRows,_
SearchDirection:=xlPrevious).Row + 1
eventName = Me.tbID.Value + " " +_
Me.tbOpName + " " +_
Me.tbStartDate.Value + "-" +_
Me.tbEndDate.Value
startDate = Format(Me.tbStartDate.Value, "dd-mmm-yyyy;#")
endDate = Format(Me.tbEndDate.Value, "dd-mmm-yyyy;#")
For startCol = 14 to 959
startDateColumn = Format(.Cells(6, startCol).Value, "dd-mmm-yyyy;#")
If StrComp(startDate, startDateColumn, vbTextCompare) = 0 Then
For endCol = 14 to 959
endDateColumn = Format(.Cells(6, endCol).Value, "dd-mmm-yyyy;#")
If StrComp(endDate, endDateColumn, vbTextCompare) = 0 Then
.Range(.Cells(lastRow, startCol), .Cells(lastRow, endCol)).Merge
.Cells(lastRow, startCol).Value = eventName
Exit For
End If
Next endCol
End If
Next startCol
Wondering if someone could help me in developing a simple user interfacing macro.
I have a set of data with the first Column (A) being dates. The date range can be an arbitrary range so could go from any start date to end date (most of the time its a 6/8 weeks). Lets say for arguments sake the date range goes from 31/12/2014 18:00 to 09/02/2015 18:00 (note date is UK format of dd/mm/yyyy). I would like the user to be asked for a start and end date range that they went - say 01/01/2015 to 31/01/2015. Once they have chosen the range the macro should delete everything BEFORE their selected date range (and shift cells up) and delete everything AFTER their selected date range. The date range is in increments of 10 minutes.
I've written some code to start off:
Public Sub DateRngInput()
Dim startDate As String
Dim endDate As String
Dim sRow As Long
Dim eRow As Long
Dim lastRow As Long
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
startDate = Left(Worksheets("Template").Cells(1, 1), 10)
endDate = Left(Worksheets("Template").Cells(lastRow, 1), 10)
sDate = InputBox("Choose Start date (dd/mm/yyyy)" & vbNewLine & vbNewLine & "Data range starts at " & startDate)
eDate = InputBox("Choose End date (dd/mm/yyyy)" & vbNewLine & vbNewLine & "Data range ends at " & endDate)
'On Error Resume Next
sRow = Worksheets("Template").Range("$A$1:$A" & lastRow).Find(sDate, LookAt:=xlPart).Row
eRow = Worksheets("Template").Range("$A$1:$A" & lastRow).Find(eDate, SearchDirection:=xlPrevious, LookAt:=xlPart).Row
MsgBox ("Your date range is from: " & vbNewLine & sDate & " at Row " & sRow & vbNewLine & "To " & vbNewLine & eDate & " at Row " & eRow)
End Sub
The macro errors out at the following line with the Run-Time error '91':
sRow = Worksheets("Template").Range("$A$1:$A" & lastRow).Find(sDate, LookAt:=xlPart).Row
Any help would be much appreciated!
Thanks.
Say we have data like:
Notice the material is not even sorted! We wish to retain only data between 1 February 2015 and 15 February 2015.
We will loop from the bottom moving up. We delete all rows outside the date limits
Sub DateKleaner()
Dim early As Date, late As Date, N As Long
Dim dt As Date
early = DateSerial(2015, 2, 1)
late = DateSerial(2015, 2, 15)
N = Cells(Rows.Count, "A").End(xlUp).Row
For i = N To 1 Step -1
dt = Cells(i, 1).Value
If dt > late Or dt < early Then
Cells(i, 1).EntireRow.Delete
End If
Next i
End Sub
We will be left with:
EDIT#1:
Here is some code which asks the User to supply the dates:
Sub DateKleaner()
Dim early As Date, late As Date, N As Long
Dim dt As Date
early = CDate(Application.InputBox(Prompt:="Please enter start date:", Type:=2))
late = CDate(Application.InputBox(Prompt:="Please enter end date:", Type:=2))
MsgBox early & vbCrLf & late
N = Cells(Rows.Count, "A").End(xlUp).Row
For i = N To 1 Step -1
dt = Cells(i, 1).Value
If dt > late Or dt < early Then
Cells(i, 1).EntireRow.Delete
End If
Next i
End Sub
Naturally you would probably use your own UserForm to accomplish the same thing.
In Calabash Automation testing on iPhone. I need to select a date from a date picker. Please guide me with a ruby step definition.
I want something like
Then I scroll datepicker to date "2002-10-22"
I made a solution after some research. This code is not bulletproof but it works fine for me. I guess someone will get a help from this. if anyone knows how to improve this. please add it here.
In step definitions I add..
Then /^I scroll datepicker to date "1985-01-01"
# Date Format "1985-01-01"
# make sure date picker is up
should_see_date_picker()
is_picker_in_date_mode()
maxdate = picker_maximum_date_time()
target = Date.parse(target_date)
current = Date.parse(datequery())
if(maxdate<target)
screenshot_and_raise "Target date'#{target}' is larger than maximum date'#{maxdate}' in date picker"
end
limit = 100
# => set year
count = 0
dir = (target.year < current.year) ? "down" : "up"
until (target.year == Date.parse(datequery()).year) or (count==limit) do
date = Date.parse(datequery())
scroll_date_component(dir, 2, date.year)
# puts("Inside the loop1 '#{count}'=> '#{date.year}'" )
count += 1
end
# => set month
count = 0
dir = (target.month < current.month) ? "down" : "up"
until (target.month == Date.parse(datequery()).month) or (count==limit) do
date = Date.parse(datequery())
scroll_date_component(dir, 0, date.month)
# puts("Inside the loop2 '#{count}'=> '#{date.month}'" )
count += 1
end
# => set day
count = 0
dir = (target.day < current.day) ? "down" : "up"
until (target.day == Date.parse(datequery()).day) or (count==limit) do
date = Date.parse(datequery())
scroll_date_component(dir, 1, date.day)
# puts("Inside the loop3 '#{count}'=> '#{date.day}'" )
count += 1
end
end
#########################################################
# => ##### Date picker helper methods. #####
def scroll_date_component(direction, column, component)
if(column==0)
# => Month scroll needs the month name string
if (direction.eql? "up")
month_str = Date::MONTHNAMES[component+1]
touch("pickerView scrollView index:#{column} label text:'#{month_str}'")
elsif (direction.eql? "down")
month_str = Date::MONTHNAMES[component-1]
touch("pickerView scrollView index:#{column} label text:'#{month_str}'")
end
else
# => Day and year scrolls are numeric
if (direction.eql? "up")
touch("pickerView scrollView index:#{column} label text:'#{component + 1}'")
elsif (direction.eql? "down")
touch("pickerView scrollView index:#{column} label text:'#{component - 1}'")
end
end
sleep(0.3)
end
def datequery()
return query("datePicker","date").first
end
def should_see_date_picker ()
if query("datePicker", :date).empty?
screenshot_and_raise "Could not find date picker"
end
end
def is_picker_in_date_mode()
res = query("datePicker", :datePickerMode)
screenshot_and_raise "expected to see a date picker" if res.empty?
screenshot_and_raise "expected to see UIDatePickerModeDate" if res.first!=1
end
def picker_maximum_date_time()
res = query("datePicker", :maximumDate)
screenshot_and_raise "expected to see a date picker" if res.empty?
return DateTime.parse(res.first) if (res.first)
end
That gist mentioned by Chathura is very out of date.
Calabash iOS now supports interaction with most date pickers natively.
https://github.com/calabash/calabash-ios/blob/develop/calabash-cucumber/features/step_definitions/calabash_steps.rb#L406
Scenario: I should be able to use the predefined steps to change the picker time
Then I change the date picker time to "10:45"
Scenario: I should be able to use the predefined steps to change the picker date
Then I change the date picker date to "July 28 2009"
Scenario: I should be able to use the predefined steps to change the picker date and time
Then I change the date picker date to "July 28" at "15:23"
I am tring to add x number of days to a Long date with a pop up box.
Public Function AskForDeadlinePlus4() As String
Dim strUserResponse As String
strUserResponse = InputBox("Enter Validuntil Date: Add # of Days To Survey end date")
strUserResponse = FormatDateTime(strUserResponse + I2, vbLongDate)
ActiveSheet.Cells(2, 10).Value = strUserResponse 'the 2, 10 is the cell reference for J2 - row 2, column 10.
End Function
Where Survey end date in cell I2.
When I run this I get (Googling how to do this I am tiring)
4 + I2 (where I2 = Friday, April 05, 2013) >> Wednesday, January 03, 1900
of course I need Tuesday, April 09, 2013
Thanks
Have you used the DateAdd function?
Sub DateExample()
Dim strUserResponse As String '## capture the user input'
Dim myDate As Date '## the date you want to add to'
Dim numDays As Double '## The number of days you want to add'
strUserResponse = InputBox("Enter Validuntil Date: Add # of Days To Survey end date")
numDays = InputBox("How many days to add?")
myDate = CDate(strUserResponse)
MsgBox DateAdd("d", numDays, myDate)
End Sub
I think this code is what your after using the DateAdd(<base e.g. Day = "D">, <number>, <date>) function:
Public Function AskForDeadlinePlus4() As String
Dim strUserResponse As Date, iNumber As Long, rResponse As Variant
AskForDeadlinePlus4 = "" 'set default value
iNumber = CLng([I2])
rResponse = InputBox("Enter Validuntil Date: Add " & iNumber & " Day(s) To Survey end date")
If rResponse = False Then
'no value entered
Exit Function
ElseIf Not IsDate(rResponse) Then
'no date entered
Exit Function
Else
'valid date entered
strUserResponse = DateAdd("D", iNumber, CDate(rResponse))
End If
AskForDeadlinePlus4 = FormatDateTime(strUserResponse, vbLongDate)
End Function
Just a few points though:
The input function will return the Boolean FALSE if no input is entered.
The test you used above is a function and will return a value when used
If you want to use in in another VBA code, i = AskForDeadlinePlus4 is its usage;
But you can also use it in a cell but only when necessary as with every calculation this will prompt an input and for every cell its in, =AskForDeadlinePlus4; and
Plus I've added a check to see if a date was entered as the user may not enter a valid one.
If you want to use in VBA:
Sub GetInfo()
'the 2, 10 is the cell reference for J2 - row 2, column 10.
ActiveSheet.Cells(2, 10).Value = AskForDeadlinePlus4
End Sub
Instead of using DateAdd, which requires more typing, you could also use DateValue. Following would do it.
DateValue(strUserResponse )+I2
Another solution would be using the conversion function, CDate.
CDate(strUserResponse )+I2