J
J P Singh
Hi There
Please help me with this issue. I have spent nearly a day trying to work
this out but it is not giving me correct results
We give out loan mobile phones to our users and we record the data as below
Mobile Number Date From Date To
07779787740 05/01/2003 19/01/2003
07779787740 22/01/2003 25/01/2003
07779787740 04/06/2003 12/06/2003
07779787740 23/06/2003 28/06/2003
07815833908 04/02/2003 24/02/2003
07815833908 14/05/2003 03/06/2003
07815833908 09/06/2003 10/06/2003
07815833908 26/06/2003 07/07/2003
When a new user wants a loan phone it is pretty difficult to see from the
above which phone will be free at what time and hence we decided to plot
this data using a VBA macro on another sheet like the following
January
1 2 3 4 5 6 7 8 9 10
07779787740
07815833908
07816820898
07855 432276
07855430172
07855432231
Putting a cross against each day when the phone is booked.
I have written the following code but I can't seems to make it to work. The
workbook is attached.
Many thanks for your help and advice
Sub displaydata()
Dim stMonth As Integer
Dim stPhone As String
Dim c As Integer
Application.ScreenUpdating = False
Sheets("Display").Select
Application.Goto Reference:="data4"
Selection.ClearContents
Selection.Interior.ColorIndex = xlNone
If Cells(1, 1).Value = "" Or Cells(1, 1).Value = "Select Month" Then
MsgBox ("Please select a month bfore proceeding")
End
Else
Select Case Cells(1, 1).Value
Case "January"
stMonth = 1
Case "February"
stMonth = 2
Case "March"
stMonth = 3
Case "April"
stMonth = 4
Case "May"
stMonth = 5
Case "June"
stMonth = 6
Case "July"
stMonth = 7
Case "August"
stMonth = 8
Case "September"
stMonth = 9
Case "October"
stMonth = 10
Case "November"
stMonth = 11
Case "December"
stMonth = 12
End Select
End If
For c = 4 To 26
stPhone = Cells(c, 1).Value
'MsgBox ("stphone no = " & stPhone)
call writedata(stMonth, stPhone, c)
Next
Sheets("display").Select
Application.ScreenUpdating = True
End Sub
Sub writedata(strMonth As Integer, strPhone As String, rowno As Integer)
Dim i As Integer
Dim startday As Integer
Dim endday As Integer
'MsgBox ("strMonth = " & strMonth & vbCrLf & "strPhone = " & strPhone &
vbCrLf & "rowno = " & rowno)
Sheets("sheet2").Select
t = ActiveSheet.UsedRange.Rows.Count
'MsgBox ("count = " & t)
For i = 2 To t
If Cells(i, 1).Value = strPhone And Month(Cells(i, 2).Value) = strMonth
Then
MsgBox (Month(Cells(i, 2).Value))
' This is to check if the date is going over to the next month
endday = Day(Cells(i, 3).Value)
startday = Day(Cells(i, 2).Value)
Sheets("Display").Select
For counter = startday To endday
Cells(rowno, counter + 1).Select
With Selection.Interior
.ColorIndex = 3
.Pattern = xlSolid
End With
Next
'MsgBox (startday & " " & endday)
End If
Next
End Sub
Please help me with this issue. I have spent nearly a day trying to work
this out but it is not giving me correct results
We give out loan mobile phones to our users and we record the data as below
Mobile Number Date From Date To
07779787740 05/01/2003 19/01/2003
07779787740 22/01/2003 25/01/2003
07779787740 04/06/2003 12/06/2003
07779787740 23/06/2003 28/06/2003
07815833908 04/02/2003 24/02/2003
07815833908 14/05/2003 03/06/2003
07815833908 09/06/2003 10/06/2003
07815833908 26/06/2003 07/07/2003
When a new user wants a loan phone it is pretty difficult to see from the
above which phone will be free at what time and hence we decided to plot
this data using a VBA macro on another sheet like the following
January
1 2 3 4 5 6 7 8 9 10
07779787740
07815833908
07816820898
07855 432276
07855430172
07855432231
Putting a cross against each day when the phone is booked.
I have written the following code but I can't seems to make it to work. The
workbook is attached.
Many thanks for your help and advice
Sub displaydata()
Dim stMonth As Integer
Dim stPhone As String
Dim c As Integer
Application.ScreenUpdating = False
Sheets("Display").Select
Application.Goto Reference:="data4"
Selection.ClearContents
Selection.Interior.ColorIndex = xlNone
If Cells(1, 1).Value = "" Or Cells(1, 1).Value = "Select Month" Then
MsgBox ("Please select a month bfore proceeding")
End
Else
Select Case Cells(1, 1).Value
Case "January"
stMonth = 1
Case "February"
stMonth = 2
Case "March"
stMonth = 3
Case "April"
stMonth = 4
Case "May"
stMonth = 5
Case "June"
stMonth = 6
Case "July"
stMonth = 7
Case "August"
stMonth = 8
Case "September"
stMonth = 9
Case "October"
stMonth = 10
Case "November"
stMonth = 11
Case "December"
stMonth = 12
End Select
End If
For c = 4 To 26
stPhone = Cells(c, 1).Value
'MsgBox ("stphone no = " & stPhone)
call writedata(stMonth, stPhone, c)
Next
Sheets("display").Select
Application.ScreenUpdating = True
End Sub
Sub writedata(strMonth As Integer, strPhone As String, rowno As Integer)
Dim i As Integer
Dim startday As Integer
Dim endday As Integer
'MsgBox ("strMonth = " & strMonth & vbCrLf & "strPhone = " & strPhone &
vbCrLf & "rowno = " & rowno)
Sheets("sheet2").Select
t = ActiveSheet.UsedRange.Rows.Count
'MsgBox ("count = " & t)
For i = 2 To t
If Cells(i, 1).Value = strPhone And Month(Cells(i, 2).Value) = strMonth
Then
MsgBox (Month(Cells(i, 2).Value))
' This is to check if the date is going over to the next month
endday = Day(Cells(i, 3).Value)
startday = Day(Cells(i, 2).Value)
Sheets("Display").Select
For counter = startday To endday
Cells(rowno, counter + 1).Select
With Selection.Interior
.ColorIndex = 3
.Pattern = xlSolid
End With
Next
'MsgBox (startday & " " & endday)
End If
Next
End Sub