VBA - Loop error probably...

Ashfaque

Search Beautiful Girls from your town for night
Local time
Tomorrow, 02:33
Joined
Sep 6, 2004
Messages
897
Hi,

I have time-sheet data of our employees (punch in and out). I am transferring tbl data to Excel sheet using below VBA code. It works but not the same as I wish.

:banghead:

Set objXL = New Excel.Application
objXL.Visible = True
Set objWkb = objXL.Workbooks.Open("D:\DelhiImport\Result\JTS-2016.xlsx")
Set objSht = objWkb.Worksheets("DELHI TIME-SHEET")

objSht.Range("A1:I1").Merge
objSht.Cells(1, 1).Value = "INTERNATIONAL AGENT GROUP"
'Font for the Title
objSht.Range("A1:A1").Font.Bold = True
objSht.Range("a1:a1").Font.Name = "Times New Roman"
objSht.Range("a1:a1").Font.Size = 12
objSht.Range("a1:a1").Font.Color = 16711680
objSht.Rows(1).RowHeight = 20

objSht.Cells(2, 1).Value = "DELHI BRANCH TIME SHEET" + "-" + Format(rst!Time, "MMM-YY")
objSht.Range("a2:I2").Merge
objSht.Cells(2, 1).HorizontalAlignment = xlCenter

objSht.Range("A2:A2").Font.Bold = True
objSht.Range("a2:a2").Font.Name = "Times New Roman"
objSht.Range("a2:a2").Font.Size = 10
objSht.Range("a2:a2").Font.Color = 0
objSht.Rows(2).RowHeight = 14

iRow = 5

Dim RowCount, PMCount As Double
RowCount = 1
PMCount = 0

Dim TempDate, TTempDate, TException

objSht.Cells(3, 1).Value = rst!Name & "-" & rst![ac-no]
objSht.Cells(3, 1).Font.Size = 7
objSht.Cells(3, 1).HorizontalAlignment = xlLeft

'
rst.MoveFirst

Do While Not rst.EOF

AMPM = Right(rst!Time, 2)
TAMPM = Right(rst!Time, 2)
TempDate = Left(rst!Time, 9)
TTempDate = Left(rst!Time, 9)
TException = rst!exception

'If AMPM <> "AM" Then GoTo CheckPM


'If TempDate = TTempDate And AMPM = "AM" Then


If TempDate = TTempDate And AMPM = "AM" And rst!exception = "Invalid" Then

PMCount = PMCount + 1

rst.MoveNext

ElseIf TempDate = TTempDate And AMPM = "AM" And rst!exception = "FOT" Then

TempDate = Left(rst!Time, 9)
objSht.Cells(iRow, 1).Value = Format(TempDate, "dd/mm/yyyy")
objSht.Cells(iRow, 1).HorizontalAlignment = xlRight
objSht.Cells(iRow, 1).Borders.Color = vbBlack

Dim Slash1, Slash2, Slash3, Slash4

Slash1 = Mid(rst!Time, 2, 1)
Slash2 = Mid(rst!Time, 4, 1)
Slash3 = Mid(rst!Time, 5, 1)

If Slash1 = "/" And Slash2 = "/" Then
TempDate = Mid(rst!Time, 9, 5)
objSht.Cells(iRow, 2).Value = Format(TempDate, "hh:mm a")
objSht.Cells(iRow, 2).HorizontalAlignment = xlCenter

ElseIf Slash1 = "/" And Slash2 = "0" Then
TempDate = Mid(rst!Time, 10, 6)
objSht.Cells(iRow, 2).Value = Format(TempDate, "hh:mm a")
objSht.Cells(iRow, 2).HorizontalAlignment = xlCenter

ElseIf Slash1 = "/" And Slash2 = "1" Then
TempDate = Mid(rst!Time, 10, 6)
objSht.Cells(iRow, 2).Value = Format(TempDate, "hh:mm a")
objSht.Cells(iRow, 2).HorizontalAlignment = xlCenter

ElseIf Slash1 = "/" And Slash2 = "3" Then
TempDate = Mid(rst!Time, 10, 6)
objSht.Cells(iRow, 2).Value = Format(TempDate, "hh:mm a")
objSht.Cells(iRow, 2).HorizontalAlignment = xlCenter

ElseIf Slash1 = "/" And Slash2 = "4" Then
TempDate = Mid(rst!Time, 10, 6)
objSht.Cells(iRow, 2).Value = Format(TempDate, "hh:mm a")
objSht.Cells(iRow, 2).HorizontalAlignment = xlCenter

ElseIf Slash1 = "/" And Slash2 = "5" Then
TempDate = Mid(rst!Time, 10, 6)
objSht.Cells(iRow, 2).Value = Format(TempDate, "hh:mm a")
objSht.Cells(iRow, 2).HorizontalAlignment = xlCenter

ElseIf Slash1 = "/" And Slash2 = "6" Then
TempDate = Mid(rst!Time, 10, 5)
objSht.Cells(iRow, 2).Value = Format(TempDate, "hh:mm a")
objSht.Cells(iRow, 2).HorizontalAlignment = xlCenter

ElseIf Slash1 = "/" And Slash2 = "7" Then
TempDate = Mid(rst!Time, 10, 5)
objSht.Cells(iRow, 2).Value = Format(TempDate, "hh:mm a")
objSht.Cells(iRow, 2).HorizontalAlignment = xlCenter

ElseIf Slash1 = "/" And Slash2 = "8" Then
TempDate = Mid(rst!Time, 10, 5)
objSht.Cells(iRow, 2).Value = Format(TempDate, "hh:mm a")
objSht.Cells(iRow, 2).HorizontalAlignment = xlCenter

ElseIf Slash1 = "/" And Slash2 = "9" Then
TempDate = Mid(rst!Time, 10, 5)
objSht.Cells(iRow, 2).Value = Format(TempDate, "hh:mm a")
objSht.Cells(iRow, 2).HorizontalAlignment = xlCenter

ElseIf Slash1 = "/" And Slash3 = "/" Then
TempDate = Mid(rst!Time, 10, 5)
objSht.Cells(iRow, 2).Value = Format(TempDate, "hh:mm a")
objSht.Cells(iRow, 2).HorizontalAlignment = xlCenter

End If


ElseIf TempDate = TTempDate And AMPM = "AM" And rst!exception <> "FOT" Then
rst.MovePrevious


TempDate = Left(rst!Time, 9)
objSht.Cells(iRow, 1).Value = Format(TempDate, "dd/mm/yyyy")

objSht.Cells(iRow, 1).HorizontalAlignment = xlRight
objSht.Cells(iRow, 1).Borders.Color = vbBlack


Slash1 = Mid(rst!Time, 2, 1)
Slash2 = Mid(rst!Time, 4, 1)
Slash3 = Mid(rst!Time, 5, 1)

If Slash1 = "/" And Slash2 = "/" Then
TempDate = Mid(rst!Time, 9, 5)
objSht.Cells(iRow, 2).Value = Format(TempDate, "hh:mm a")
objSht.Cells(iRow, 2).HorizontalAlignment = xlCenter

ElseIf Slash1 = "/" And Slash2 = "0" Then
TempDate = Mid(rst!Time, 10, 6)
objSht.Cells(iRow, 2).Value = Format(TempDate, "hh:mm a")
objSht.Cells(iRow, 2).HorizontalAlignment = xlCenter

ElseIf Slash1 = "/" And Slash2 = "1" Then
TempDate = Mid(rst!Time, 10, 6)
objSht.Cells(iRow, 2).Value = Format(TempDate, "hh:mm a")
objSht.Cells(iRow, 2).HorizontalAlignment = xlCenter

ElseIf Slash1 = "/" And Slash2 = "3" Then
TempDate = Mid(rst!Time, 10, 6)
objSht.Cells(iRow, 2).Value = Format(TempDate, "hh:mm a")
objSht.Cells(iRow, 2).HorizontalAlignment = xlCenter

ElseIf Slash1 = "/" And Slash2 = "4" Then
TempDate = Mid(rst!Time, 10, 6)
objSht.Cells(iRow, 2).Value = Format(TempDate, "hh:mm a")
objSht.Cells(iRow, 2).HorizontalAlignment = xlCenter

ElseIf Slash1 = "/" And Slash2 = "5" Then
TempDate = Mid(rst!Time, 10, 6)
objSht.Cells(iRow, 2).Value = Format(TempDate, "hh:mm a")
objSht.Cells(iRow, 2).HorizontalAlignment = xlCenter

ElseIf Slash1 = "/" And Slash2 = "6" Then
TempDate = Mid(rst!Time, 10, 5)
objSht.Cells(iRow, 2).Value = Format(TempDate, "hh:mm a")
objSht.Cells(iRow, 2).HorizontalAlignment = xlCenter

ElseIf Slash1 = "/" And Slash2 = "7" Then
TempDate = Mid(rst!Time, 10, 5)
objSht.Cells(iRow, 2).Value = Format(TempDate, "hh:mm a")
objSht.Cells(iRow, 2).HorizontalAlignment = xlCenter

ElseIf Slash1 = "/" And Slash2 = "8" Then
TempDate = Mid(rst!Time, 10, 5)
objSht.Cells(iRow, 2).Value = Format(TempDate, "hh:mm a")
objSht.Cells(iRow, 2).HorizontalAlignment = xlCenter

ElseIf Slash1 = "/" And Slash2 = "9" Then
TempDate = Mid(rst!Time, 10, 5)
objSht.Cells(iRow, 2).Value = Format(TempDate, "hh:mm a")
objSht.Cells(iRow, 2).HorizontalAlignment = xlCenter

ElseIf Slash1 = "/" And Slash3 = "/" Then
TempDate = Mid(rst!Time, 10, 5)
objSht.Cells(iRow, 2).Value = Format(TempDate, "hh:mm a")
objSht.Cells(iRow, 2).HorizontalAlignment = xlCenter

End If



ElseIf TempDate = TTempDate And AMPM = "PM" And rst!exception = "Invalid" Then
'iRow = iRow + 1
rst.MoveNext
'Loop

ElseIf TempDate = TTempDate And AMPM = "PM" And rst!exception = "FOT" Then

PMCount = 1

iRow = iRow - 1

If Slash1 = "/" And Slash2 = "/" Then
TempDate = Mid(rst!Time, 10, 5)
objSht.Cells(iRow, 5).Value = Format(TempDate, "hh:mm p")
objSht.Cells(iRow, 5).HorizontalAlignment = xlCenter

ElseIf Slash1 = "/" And Slash2 = "0" Then
TempDate = Mid(rst!Time, 10, 6)
objSht.Cells(iRow, 5).Value = Format(TempDate, "hh:mm p")
objSht.Cells(iRow, 5).HorizontalAlignment = xlCenter

ElseIf Slash1 = "/" And Slash2 = "1" Then
TempDate = Mid(rst!Time, 10, 6)
objSht.Cells(iRow, 5).Value = Format(TempDate, "hh:mm p")
objSht.Cells(iRow, 5).HorizontalAlignment = xlCenter

ElseIf Slash1 = "/" And Slash2 = "3" Then
TempDate = Mid(rst!Time, 10, 6)
objSht.Cells(iRow, 5).Value = Format(TempDate, "hh:mm p")
objSht.Cells(iRow, 5).HorizontalAlignment = xlCenter

ElseIf Slash1 = "/" And Slash2 = "4" Then
TempDate = Mid(rst!Time, 10, 6)
objSht.Cells(iRow, 5).Value = Format(TempDate, "hh:mm p")
objSht.Cells(iRow, 5).HorizontalAlignment = xlCenter

ElseIf Slash1 = "/" And Slash2 = "5" Then
TempDate = Mid(rst!Time, 10, 6)
objSht.Cells(iRow, 5).Value = Format(TempDate, "hh:mm p")
objSht.Cells(iRow, 5).HorizontalAlignment = xlCenter


ElseIf Slash1 = "/" And Slash2 = "6" Then
TempDate = Mid(rst!Time, 10, 6)
objSht.Cells(iRow, 5).Value = Format(TempDate, "hh:mm p")
objSht.Cells(iRow, 5).HorizontalAlignment = xlCenter

ElseIf Slash1 = "/" And Slash2 = "7" Then
TempDate = Mid(rst!Time, 10, 6)
objSht.Cells(iRow, 5).Value = Format(TempDate, "hh:mm p")
objSht.Cells(iRow, 5).HorizontalAlignment = xlCenter

ElseIf Slash1 = "/" And Slash2 = "8" Then
TempDate = Mid(rst!Time, 10, 6)
objSht.Cells(iRow, 5).Value = Format(TempDate, "hh:mm p")
objSht.Cells(iRow, 5).HorizontalAlignment = xlCenter

ElseIf Slash1 = "/" And Slash2 = "9" Then
TempDate = Mid(rst!Time, 10, 6)
objSht.Cells(iRow, 5).Value = Format(TempDate, "hh:mm p")
objSht.Cells(iRow, 5).HorizontalAlignment = xlCenter

ElseIf Slash1 = "/" And Slash2 = "1" Then
TempDate = Mid(rst!Time, 10, 6)
objSht.Cells(iRow, 5).Value = Format(TempDate, "hh:mm p")
objSht.Cells(iRow, 5).HorizontalAlignment = xlCenter
End If
ElseIf TempDate = TTempDate Or AMPM = "AM" And rst![exception] <> "FOT" Then

iRow = iRow + 1


TempDate = Mid(rst!Time, 10, 5)
TTempDate = Left(rst!Time, 9)
objSht.Cells(iRow, 1).Value = TTempDate
objSht.Cells(iRow, 2).Value = TempDate
objSht.Cells(iRow, 2).HorizontalAlignment = xlCenter

End If

iRow = iRow + 1

RowCount = RowCount + 1

rst.MoveNext

Loop

further code.....

If you see the JPG of my tbl data, I have stucked somewhere in the code which is repeating one date...

Sometime,employee is punching out during morning office session without looking if the punching machine is set on IN or OUT. Hence many times there are more than one IN on the same date. Moreover sometime it error so "Invalid" records in the sheet.

Each day 2 records are correct. One is AM and other is PM with FOT remark at one date.

But sometime, there are 3 records on same date with 2 AM and 1 PM or 1 AM with 2 PM - indicating INvalid or FOT.

I suspect my loop is not properly handled by me.

What I want is :

1. if AM is with "Invalid" but no other record is available with FOT on same date, my code should collect this and devide its date and time factor in 2 cells.
2. If first record of the date is falling with PM then it should look for AM record for same date. And if there is no AM record at all in the same date then right OUT column of my excel sheet should be filled only and IN should be written with "No Puch" some thing like.

I managed to solve somehow but not fully working. Also I need shorten my vba code I have written with IF - END IF (if possible)

Please help.

Thanks in advance
 

Attachments

  • TimeSheet.jpg
    TimeSheet.jpg
    98.9 KB · Views: 96
  • ResultSheet.jpg
    ResultSheet.jpg
    42.1 KB · Views: 95
can you use the code tags (on advanced editor) on your code to preserve formatting. Would make it much easier to read.

Some observations -

you are using rst as a recordset but cannot see where this has been declared or assigned a value.

You are using Time as a field name. Time is a reserved word and using it as a field or control name can cause unexepected issues

From your code Time would appear to be a text field and not date/time - is this correct?

From the description of what you are trying to achieve at the bottom of your post, this could be done in a relatively simple query - is there any reason for using vba code?

If you need to stick with VBA Some things to try - step through the code - where it does not break out the loop is where you have your problem

I can provide a SQL solution if required but no time now to provide. Would also need to understand the actual rules

- does everyone without exception start in the morning and finish in the afternoon? or can you have someone who starts and finishes in the morning (or afternoon).

- Where you have multiple checkins on the same day and a minute or so apart and regardless of the state column setting you ignore completely (invalid), why not just just take the earliest time for the date as checkin time and the lastest time as the checkout, ignoring any times in between? And the difference between earliest and latest perhaps needs to be over a certain amount (e.g. 1 hour) for it to be valid
 
Thanks CJ,

I agree with you about, we should consider the earliest time of the date and check in time and latest as the checkout. But sometimes, either of is not available and in that case, we prefer to input that part as 'No Punch" something like.

I tried to shorten the code in some more flexible way but still there are blank line appears and not sure if it considers earliest time of the date as check in.

Here is code and its result in the pic.

Public Sub ProcRep1()

Dim objXL As Excel.Application
Dim objWkb As Excel.Workbook
Dim objSht As Excel.Worksheet
Dim AMPM, TAMPM
Dim rst As Recordset

Dim iRow, XlRow As Integer

Set rst = CurrentDb.OpenRecordset("SELECT T_JeddahTS.[AC-NO], T_JeddahTS.No, T_JeddahTS.Name, " & _
"T_JeddahTS.Time, T_JeddahTS.State, T_JeddahTS.eXCEPTION, T_JeddahTS.[New State] FROM T_JeddahTS ;")

If rst.EOF And rst.BOF Then
MsgBox ("No Records In This Month"), vbInformation, "Null Records Inf."
Exit Sub
Else


Set objXL = New Excel.Application
objXL.Visible = True
Set objWkb = objXL.Workbooks.Open("D:\JeddahImport\JedResult\JEDDAH-TS-2016.xlsx")
Set objSht = objWkb.Worksheets("DELHI TIME-SHEET")

objSht.Range("A1:I1").Merge
objSht.Cells(1, 1).Value = "INTERNATIONAL AGENT GROUP"

objSht.Range("A1:A1").Font.Bold = True
objSht.Range("a1:a1").Font.Name = "Times New Roman"
objSht.Range("a1:a1").Font.Size = 12
objSht.Range("a1:a1").Font.Color = 16711680
objSht.Rows(1).RowHeight = 20

objSht.Cells(2, 1).Value = "DELHI BRANCH TIME SHEET" + "-" + Format(rst!Time, "MMM-YY")
objSht.Range("a2:I2").Merge
objSht.Cells(2, 1).HorizontalAlignment = xlCenter

objSht.Range("A2:A2").Font.Bold = True
objSht.Range("a2:a2").Font.Name = "Times New Roman"
objSht.Range("a2:a2").Font.Size = 10
objSht.Range("a2:a2").Font.Color = 0
objSht.Rows(2).RowHeight = 10

iRow = 5

Dim RowCount, PMCount As Double
RowCount = 1
PMCount = 0

Dim TempDate, TTempDate

objSht.Cells(3, 1).Value = rst!Name & "-" & rst![ac-no]
objSht.Cells(3, 1).Font.Size = 7
objSht.Cells(3, 1).HorizontalAlignment = xlLeft

PMCount = 1

rst.MoveFirst

Do While Not rst.EOF

AMPM = Right(rst!Time, 2)
TAMPM = Right(rst!Time, 2)
TempDate = Left(rst!Time, 9)
TTempDate = Left(rst!Time, 9)


If AMPM = "AM" And rst![NEW STATE] = "OverTime In" And rst!exception = "FOT" Then

TempDate = Left(rst!Time, 9)
objSht.Cells(iRow, 1).Value = Format(TempDate, "dd/mm/yyyy")
'objSht.Cells(iRow, 1).Value = RowCount
objSht.Cells(iRow, 1).HorizontalAlignment = xlRight
objSht.Cells(iRow, 1).Borders.Color = vbBlack
TempDate = Right(rst!Time, 8)
objSht.Cells(iRow, 2).Value = TempDate
objSht.Cells(iRow, 2).HorizontalAlignment = xlCenter

ElseIf TempDate = TTempDate And AMPM = "PM" And rst![exception] = "Invalid" Or rst!exception = "FOT" Then

PMCount = 1

iRow = iRow - 1

TempDate = Right(rst!Time, 8)
objSht.Cells(iRow, 5).Value = TempDate
objSht.Cells(iRow, 5).HorizontalAlignment = xlCenter

ElseIf TempDate = TTempDate Or AMPM = "AM" And rst![exception] <> "FOT" Then

iRow = iRow + 1
TempDate = Right(rst!Time, 8)
TTempDate = Left(rst!Time, 9)
objSht.Cells(iRow, 1).Value = TTempDate
objSht.Cells(iRow, 2).Value = TempDate
objSht.Cells(iRow, 2).HorizontalAlignment = xlCenter

End If

iRow = iRow + 1

RowCount = RowCount + 1

rst.MoveNext

Loop

objSht.Tab.Color = 110
objXL.ActiveSheet.Name = "DELHI TIME-SHEET"

If rst.BOF Then
'no records
Beep
MsgBox "There were no records with the date range you specified!"

Else

End If

Set objSht = Nothing
Set objWkb = Nothing
Set objXL = Nothing
rst.Close

End If
End Sub
 

Attachments

  • Result-2.jpg
    Result-2.jpg
    70.8 KB · Views: 88
as previous requested, please use code tags to preserve indentation to make it more readable.

You have not answered my questions

you have not said if you have tried stepping through the code to see what happens

So at this point I don't have anything else to add
 
HI CJ,

I have made little change in code of my attached db.

I have stepped through many times. When it reaches to more than 2 records (like July 10 has 3 times entry), below line of code takes the record and prints it adding line.

ElseIf TempDate = TTempDate And AMPM = "PM" And rst![STATE] = "C/Out" Or rst![STATE] = "C/In" Then


If TempDate = DummyDate And AMPM = "PM" And PMCount < 2 Then
PMCount = PMCount + 1
If PMCount = 2 Then
GoTo EndCheck
Else
End If
End If

iRow = iRow - 1

The above portion of code I below is the reason I believe.

Basically it should count if there are more than a single record with AM or PM in same date - not matter with FOT or Invalid, it should read next record along with earliest time.

Please have a look at my db and advise.
Thanks in advance.
 

Attachments

as previously stated

as previous requested, please use code tags to preserve indentation to make it more readable.

You have not answered my questions

and regret I cannot open your zip file
 
If you could open module "M_ExportToExcel", I have inserted there comments.

Sorry, I dont know about code tag which you mean.

I again attached db. May be this will be openable....
 

Attachments

code tags can be found on the advanced editor - highlight your code and click on the # button.

Have been able to open the file - I'm sure I've seen that data before somewhere 0 or same headings - problem was solved in a fairly simple query which could then be exported to excel.

Why are you trying to do this all in VBA - is it a class project requiring you to do it this way?
 
I can't find the sql right now but I've created this from your table

Code:
 SELECT L.*, F.*
FROM T_JeddahTS AS L INNER JOIN T_JeddahTS AS F ON L.[AC-No] = F.[AC-No]
WHERE (((TimeValue([l].[Time]))=(SELECT max(timevalue([time])) from [T_JeddahTS] T where [ac-no]=l.[ac-no] and datevalue([time])=datevalue(l.[time]))) AND ((DateValue([L].[Time]))=DateValue([F].[Time])) AND ((TimeValue([f].[Time]))=(SELECT min(timevalue([time])) from [T_JeddahTS] T where [ac-no]=l.[ac-no] and datevalue([time])=datevalue(l.[time]))));

Alias L means 'Last', F means 'First'
 
The familier data is from a newly purchased punching machine. The titles are by default in it. We are just generating from machine but the default producer in machine represents pdf format. So we do convert the data to excel sheet first and then import to access table.

I didnt get from your SELECT L.*, F.* line
 
just copy and paste the whole code into a new query (go to the sql window) and run it. It will put the last and first records for each date on the same row - you can then select whichever fields you require to export to excel.
 
Thanks CJ,

With your query idea, I almost done except below small issue.

Code:
objSht.Cells(iRow, 5).Value = Format(TempDate, "hh:mm p")

From these above vba code, timings are appearing in 12 hours format. I need them to appear in 24 hours format so that sum of the time would be easy.

Any idea ?
 
Thanks CJ. It is working.
:)
 

Users who are viewing this thread

Back
Top Bottom