[Part 1 - Original question]
I have values like 30, 31, 28 or 29 which are total days of the month.
I want to make a for loop
If I select 28 it should display a msgbox 28 times.
If I select 31 it should display a msgbox 31 times.
The code I tried:
Dim dayst As Variant
Dim tot1 As Variant
tot1 = DateDiff("d", "01/2011", DateAdd("m", 1, "01/2011"))
tot1 = Split(tot1, ",")
For Each dayst In tot1
MsgBox dayst
Next
The above code is showing "31" in the msgbox, instead of 31 times like "1", "2", ... "31"
I want to display a msgbox 31 times incrementing from 1 to 31.
[Part 2 - Updated request]
Default Column Value Example
ID 1 2 ..... 31 totaldays
001 Yes Yes .... Yes 31
002 Yes Yes .... Yes 31
003 Yes Yes .... Yes 31
.....
001 is coming from table
Yes is the default column value for 1 to 31 or 1 to 28
totaldays should be no of days permonth.
How can I accomplish this using vb6.
You could just use a simple loop like this - although I dont see why you would want to have 28-31 MsgBox prompts in a row
Dim tot1 As Long
Dim lngDays As Long
tot1 = DateDiff("d", "01/2011", DateAdd("m", 1, "01/2011"))
For lngDays = 1 To tot1
MsgBox lngDays
Next
Updated version - adds early exit option
Dim tot1 As Long
Dim lngDays As Long
Dim lngExit As Long
tot1 = DateDiff("d", "01/2011", DateAdd("m", 1, "01/2011"))
For lngDays = 1 To tot1
lngExit = MsgBox(lngDays, vbOKCancel, "Press Cancel to exit")
If lngExit = vbCancel Then Exit Sub
Next
Related
In a text file consisting of thousands of records, each having greater than 20 lines of data, I need to count the 14th line after the start of every record if that 14th line is blank. The line is either blank or contains a date.
The start of every record is the same: "1 Start of new record"
Scenario:
1 Start of new record
2 some data
3 "
4 "
5 "
6 "
7 "
8 "
9 "
10 "
11 "
12 "
13 "
14
...
1 Start of new record
...
8 "
9 "
10 "
...
14 10/19/2019
...
In this simple scenario, the result should be 1. I have code that copies line 1 of every record into a second file.
The result obviously being:
1 Start of new record
1 Start of new record
...
Here is the code I have:
Const ForReading = 1
Dim words(1)
Dim msg
words(0) = "1 Start of New Record"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set inFile = objFSO.OpenTextFile("c:\Temp\altest.txt", ForReading)
Set outFile = objFSO.OpenTextFile("c:\Temp\altest_output.txt", 8, True)
Do Until inFile.AtEndOfStream
strSearchString = inFile.ReadLine
For i = 0 To UBound(words)-1
If InStr(strSearchString,words(i)) Then
msg = msg&strSearchString&vbcrlf
End If
next
Loop
inFile.Close
outfile.WriteLine msg
WScript.Echo "Done!"
This seems like a good start, but again, I need to count the 14th line after the start of every record if that 14th line is blank.
Any help is greatly appreciated.
-Alel
Hardly elegant but something like this should get you on your way. This doesn't use SkipLine, it just marks the next line of interest:
Option Explicit 'force explicit variable declaration, this is just good practice
Const ForReading = 1
Dim strContent
Dim Offset : Offset = 14 'define the 14th 'line'
Dim StartLine
Dim NewRecordMarker : NewRecordMarker = "1 Start of new record" 'just use a string to match
Dim objFSO, inFile, outFile
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set inFile = objFSO.OpenTextFile("e:\Temp\altest.txt", ForReading)
Set outFile = objFSO.OpenTextFile("e:\Temp\altest_output.txt", 8, True)
'notice we're only reading forward
'that means we can set the next LineOfInterest without having to worry about
'exceeding AtEndOfStream like we would if we'd use SkipLine
'this is just simpler.
'this obviously falls apart when the line of interest is NOT the 14th line
Do Until inFile.AtEndOfStream
Dim LineOfInterest
strContent = inFile.ReadLine 'inFile.Line will at 2 at this point because we just read it
If strContent = NewRecordMarker Then 'found a new record, we want to look 14 lines from here
LineOfInterest = inFile.line - 1 + Offset ' -1 or we'll overshoot our target
End If
If inFile.Line = LineOfInterest Then 'this is the line we want to inspect
outFile.WriteLine strContent 'just write out entire value, no checking for date here
End If
Loop
inFile.Close
outFile.Close
WScript.Echo "Done!"
I'm creating a payroll system I want to calculate the minute late of Employee using two dtpicker
Dtpicker1 is for time in and Dtpicker2 for Timeout
Private Sub calc_Click()
oras = DateDiff("n", DTPicker1, DTPicker2)
Text1.Text = oras
End sub
If all employees are working the same amount of hours (8 hours/day for example):
Private Sub calc_Click()
Dim iWorkdayHours As Integer
Dim iMinutesWorked As Integer
Dim iMinutesLate As Integer
' Get the amount of minutes between two dates
iMinutesWorked = DateDiff("n", DTPicker1, DTPicker2)
' Get number of hours employee should have worked
iWorkdayHours = 8
iMinutesLate = (iWorkdayHours * 60) - iMinutesWorked
If iMinutesLate > 0 Then
Text1.Text = iMinutesLate & " minutes late."
Else
Text1.Text = "On time."
End If
End Sub
If employees have different shift lengths, you can update iWorkdayHours.
I have the following problem
In a given range for example 1 Jan 2017 to 31 Jan 2017,
How many days of the following range events period occurred?
Example
1 range 1 Dec 2016 / 30 Jun 2017 = 31
2 range 1 Jan 2017 / 2 Jan 2017 = 2
3 range 4 Aug 2017 / 31 Aug 2017 = 0
4 range 24 Sep 2015 / 2 Jan 2017 = 2
5 range 6 Jan 2015 / 6 Feb 2016 = 0
Do you have some idea for an algorithm in access-VBA?
Many thanks
Public Function DaysInRange(vntRngStart As Date, vntRngEnd As Date, vntTestStart As Date, vntTestEnd As Date) As Integer
On Error GoTo PROC_ERR
Dim vntOverlapStart As Date
Dim vntOverlapEnd As Date
If vntRngStart > vntRngEnd Then
MsgBox "Main date range is specified back-to-front, swap the dates and try again.", vbInformation, "Invalid input..."
DaysInRange = -1
Exit Function
ElseIf vntTestStart > vntTestEnd Then
MsgBox "Test date range is specified back-to-front, swap the dates and try again.", vbInformation, "Invalid input..."
DaysInRange = -2
Exit Function
End If
If vntTestEnd < vntRngStart Or vntTestStart > vntRngEnd Then
'Either your test range ends before the given range starts,
'or the test range starts after the end of the given range,
'so there is no overlap between the two ranges.
DaysInRange = 0
Exit Function
End If
'So now we know that there must be some overlap
If vntTestStart <= vntRngStart Then
'Our test range starts before the start of the given range,
'so the overlap starts at the beginning of the given range
vntOverlapStart = vntRngStart
Else
'Our test range starts after the start of the given range,
'so the overlap starts at the beginning of the test range
vntOverlapStart = vntTestStart
End If
If vntTestEnd >= vntRngEnd Then
'Our test range ends after the end of the given range,
'so the overlap ends at the end of the given range
vntOverlapEnd = vntRngEnd
Else
'Our test range ends after the end of the given range,
'so the overlap ends at the end of the test range
vntOverlapEnd = vntTestEnd
End If
DaysInRange = DateDiff("d", vntOverlapStart, vntOverlapEnd) + 1
PROC_EXIT:
On Error Resume Next
Exit Function
PROC_ERR:
MsgBox "Error " & Err.Number & " in Function 'DaysInRange': " & Err.Description
Resume PROC_EXIT
End Function
I'd like to use excel 2010 to realize a function to first compare values from 2 different Excel sheets and then sort them based on another column value.
For example:
In sheet 1, I've got:
Name Value
Test 1 100.5
Test 1 200.6
Test 1 300.3
Test 2 100.8
Test 2 200.6
Test 3 200.5
In sheet 2, I've got :
Name
Test 1
Test 1
Test 1
Test 3
what I want to achieve is if the name from sheet 1 is not in sheet 2, delete the whole line in sheet 1 and sort by descending the name based on the column value.
Desired:
Name Value
Test 1 300.3
Test 1 200.6
Test 1 100.5
Test 3 200.5
Here is what I get so far:
Sub test()
Dim wb As Workbook
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim i As Integer, j As Integer
Dim lastRow1 As Integer, lastRow2 As Integer
On Error GoTo 0
Set wb = ActiveWorkbook
Set ws1 = wb.Worksheets("Sheet1")
Set ws2 = wb.Worksheets("Sheet2")
lastRow1 = ws1.UsedRange.Rows.Count
lastRow2 = ws2.UsedRange.Rows.Count
For i = 2 To lastRow1
For j = 2 To lastRow2
If ws1.Cells(i, 1).Value <> "" Then 'This will omit blank cells at the end (in the event that the column lengths are not equal.
If InStr(1, ws2.Cells(j, 1).Value, ws1.Cells(i, 1).Value, vbTextCompare) < 1 Then
Rows(i).EntireRow.delete
Exit For
End If
End If
Next j
Next i
End Sub
Please suggest and help. thank you very much in advance.
I changed your code so it is working:
Sub test()
Dim wb As Workbook
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim i As Integer, j As Integer
Dim lastRow1 As Integer, lastRow2 As Integer
On Error GoTo 0
Set wb = ActiveWorkbook
Set ws1 = wb.Worksheets("Sheet1")
Set ws2 = wb.Worksheets("Sheet2")
lastRow1 = ws1.Cells(Rows.Count, 1).End(xlUp).Row 'last used cell in column A
lastRow2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row 'last used cell in column A
Dim same As Boolean
same = False
For i = lastRow1 To 2 Step -1 'bottom to top
For j = 2 To lastRow2
Debug.Print ws1.Cells(i, 1).Value
Debug.Print ws2.Cells(j, 1).Value
If ws1.Cells(i, 1).Value <> "" Then 'This will omit blank cells at the end (in the event that the column lengths are not equal.
If ws1.Cells(i, 1).Value = ws2.Cells(j, 1).Value Then
same = True 'set True if match
End If
End If
Next j
If same = False Then 'if no match
Rows(i).EntireRow.Delete
End If
same = False
Next i
'sort
lastRow1 = ws1.Cells(Rows.Count, 1).End(xlUp).Row
Range("A2:B" & lastRow1).Sort key1:=Range("A2:A" & lastRow1), order1:=xlAscending, Header:=xlNo, key2:=Range("B2:B" & lastRow1), order2:=xlAscending, Header:=xlNo
End Sub
Still thinking about the rest of the answer, but in advance I would advise you to start at the bottom of the list (so from lastrow to the second row) The reason for this is that you are removing rows which your counter does not take into account. You may also want to look into the MATCH function in Excel to see if a certain value is used in a list instead of going through the whole list.
I have a flexgrid with a grouping, and a .subtotal by that grouping. All columns except one are numeric, the one that isn't is in the format 'x/y' e.g. '1/5', i.e. 1 out of 5 items supplied.
if I do a .Subtotal with a flexSTSum it sums up the first number in the pair, i.e. in the above example it would sum up the 1 as a decimal and show 1.00 in the subtotal row
At first I tried to find a way to sum on another column, i.e. I could put individual values into separate columns, give them a .Width of 0 and sum these into the .Subtotal column of the first column, but I can't find a way to do that.
And even if I do find a way to do that I want to be able to custom format the .Subtotal, so it appears as '3/17', i.e. '1/5' and '2/12' subtotal to '3/17' in the subtotal row.
if I can't subtotal off another column I wondered if I could custom access the subtotal row and manually enter the subtotal value of '3/17', but even that seems unavailable.
My question is, is there a way to achieve this?
I assume you are using the VideoSoft FlexGrid which i never used, so I can't help you with the specific methods of that control.
You can do it easily with a standard MSFlexGrid control though, and you can probably do the same with the VideoSoft FlexGrid.
Have a look at the following sample project:
'1 form with :
' 1 msflexgrid control : name=MSFlexGrid1
Option Explicit
Private Sub Form_Load()
Dim lngRow As Long, lngCol As Long
With MSFlexGrid1
.Rows = 10
.Cols = 4
.FixedRows = 0
.FixedCols = 0
For lngRow = 0 To .Rows - 2
For lngCol = 0 To .Cols - 2
.TextMatrix(lngRow, lngCol) = CStr(100 * lngRow + lngCol)
Next lngCol
.TextMatrix(lngRow, .Cols - 1) = CStr(lngRow) & "/" & CStr(lngRow * lngRow)
Next lngRow
End With 'MSFlexGrid1
End Sub
Private Sub Form_Resize()
MSFlexGrid1.Move 0, 0, ScaleWidth, ScaleHeight
End Sub
Private Sub MSFlexGrid1_Click()
Dim lngCol As Long
'calculate subtotals
With MSFlexGrid1
For lngCol = 0 To .Cols - 2
.TextMatrix(.Rows - 1, lngCol) = CStr(GetTotal(lngCol))
Next lngCol
.TextMatrix(.Rows - 1, .Cols - 1) = GetTotalSpecial(.Cols - 1)
End With 'MSFlexGrid1
End Sub
Private Function GetTotal(lngCol As Long) As Long
Dim lngRow As Long
Dim lngTotal As Long
With MSFlexGrid1
lngTotal = 0
For lngRow = 0 To .Rows - 2
lngTotal = lngTotal + Val(.TextMatrix(lngRow, lngCol))
Next lngRow
End With 'MSFlexGrid1
GetTotal = lngTotal
End Function
Private Function GetTotalSpecial(lngCol As Long) As String
Dim lngRow As Long
Dim lngTotal1 As Long, lngTotal2 As Long
Dim strPart() As String
With MSFlexGrid1
lngTotal1 = 0
lngTotal2 = 0
For lngRow = 0 To .Rows - 2
strPart = Split(.TextMatrix(lngRow, .Cols - 1), "/")
If UBound(strPart) = 1 Then
lngTotal1 = lngTotal1 + Val(strPart(0))
lngTotal2 = lngTotal2 + Val(strPart(1))
End If
Next lngRow
End With 'MSFlexGrid1
GetTotalSpecial = CStr(lngTotal1) & "/" & CStr(lngTotal2)
End Function
It will load a grid with some values, and when you click on the grid, the subtotals will be calculated and filled into the last row.