ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Loop Code (https://www.excelbanter.com/excel-programming/347261-loop-code.html)

sheeba

Loop Code
 
Hello Gurus,

I am making a report of time in and time out with highlighting the
duraation.

The report work except that even if on the first report row is having
the same date and the specific time duration is empty it is going to
the nexrt row.

How i cud make to chack every time starting from second row(initial
RepCell) and if the interior color index is none and date is same
highligh the duration on the first report row itself?

Thanks

Sub ReportTest()

' data sorted on date and ArvTime
Sheets("TempReport").Select

Set CurCell = Worksheets("Data").Range("A2")
Set RepCell = Worksheets("TempReport").Range("A2")

Do While Not IsEmpty(CurCell)
Set X = CurCell.Offset(0, 3) 'ArvTime
Set Y = CurCell.Offset(0, 4) 'DepTime
Set W = CurCell.Offset(0, 5) 'Craft


STCol = Application.Match(X, Range("TimeS"), 0)
EDCol = Application.Match(Y, Range("TimeS"), 0)

CLR = Application.VLookup(CurCell, Range("AirDetails"), 3, False)

SDate = DateValue(TxtFrDate)
EDate = DateValue(TxtToDate)

Set NextCell = CurCell.Offset(1, 0)
Set NewRepCell = RepCell.Offset(1, 0)

'only data within date range
If CurCell.Offset(0, 2) = SDate And CurCell.Offset(0, 2) <= EDate
Then

RepCelll.FormulaR1C1 = CurCell.Offset(0, 2)
RepCell.Offset(0, STCol) = W
Range(RepCell.Offset(0, STCol), repcell.Offset(0, EDCol -
1)).Interior.ColorIndex = CLR
Range(repcell.Offset(0, STCol), repcell.Offset(0, EDCol -
1)).HorizontalAlignment = xlCenterAcrossSelection
Range(repcell.Offset(0, STCol), repcell.Offset(0, EDCol - 1)).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="",
SubAddress:= _
"Data!" & CurCell.Address, ScreenTip:=CurCell.Value

If CurCell.Offset(0, 2).Value = NextCell.Offset(0, 2).Value _
And NextCell.Offset(0, 3) CurCell.Offset(0, 4) Then
Set CurCell = NextCell
Else
Set CurCell = NextCell
Set repcell = NewRepCell
End If
Else
Set CurCell = NextCell
End If


Loop



All times are GMT +1. The time now is 04:40 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com