'#43800 = 01/12/2019 
Option Explicit

Dim pm as Object
	Set pm = CreateObject("PlanMaker.Application")
	pm.Visible = True
'	pm.Workbooks.Open("E:\Test Accounts\Accounts.xlsx")
'	pm.Activate
Dim EntryMonth As String, item As String, epoch As String, count As Integer
Dim EntryDate As Date, inout As Integer, Blue As Integer, valu As Single
Dim ItemList$(12)
	ItemList(0) = " "
	ItemList(1) = "T"
	ItemList(2) = "M"
	ItemList(3) = "Th"
	ItemList(4) = "B"
	ItemList(5) = "A"
	ItemList(6) = "C"
	ItemList(7) = "A"
	ItemList(8) = "H"
	ItemList(9) = "D"
	ItemList(10) = "C"
	ItemList(11) = "W"
Dim PayList$(14)
	PayList(0) = " "
	PayList(1) = "B"
	PayList(2) = "B1"
	PayList(3) = "C"
	PayList(4) = "S"
	PayList(5) = "R"
	PayList(6) = "C"
	PayList(7) = "G"
	PayList(8) = "Du"
	PayList(9) = "BT"
	PayList(10) = "Ho"
	PayList(11) = "Ho1"
	PayList(12) = "E"
	PayList(13) = "D"
Begin Dialog EnterData 1000, 400, 160, 100, "Enter Data", .dlgFunc
	CancelButton 5, 85, 50, 10
	OKButton 60, 85, 40, 10
	DropListBox 5, 5, 50, 80, ItemList$(), .Drop1
	Text 5, 17, 40, 10, "Pu"
	DropListBox 105, 5, 50, 80, PayList$(), .Drop2
	Text 105, 17, 40, 10, "Pa"
	TextBox 60, 5, 40, 10, .TxtBox1
	Text 60, 17, 40, 10, "Am"
	TextBox 5, 35, 40, 10, .TxtBox4
	Text 5, 47, 40,10, "I" 
	TextBox 60, 35, 40, 10, .TxtBox2
	PushButton 65,47, 10, 10, "-", .btn1
	PushButton 85, 47, 10, 10, "+", .btn2
	TextBox 5, 65, 145, 10, .TxtBox3
	PushButton 105, 85, 50, 10, "Fi", .btn3
End Dialog

Dim dlg As EnterData, btn%, money As Single, cntempty%

'#Enter any data since last update, Auto then manual
'DATA =============================================================
pm.ActiveWorkbook.Sheets("Data").Activate
'#Number of days since last update #Following line doesn't work across months
''	count = pm.Range("E1").value - pm.Range("LastUpdate").value

count =pm.Range("L2").Value
If count > 0 Then
	Update
End If
'#These dates could have changed if Update ren.
EntryDate = pm.Range("LastUpdate").value
EntryMonth = Format(pm.Range("LastUpdate").Value, "mmm")
epoch=Format(EntryDate, int)
Dlg.TxtBox2 = Format(epoch,"dd"&"/"&"mm"&"/"&"yyyy")

'#Get ready for manual input
pm.ActiveWorkbook.Sheets(EntryMonth).Activate

'#Move to first empty cell
cntempty = 1
pm.Range("A2").Select
Do Until pm.ActiveCell.Value = ""
	cntempty = cntempty + 1
	pm.ActiveCell.Item(2, 1).Select
Loop
pm.Range("a" & cntempty).Select

'#Repeat entering data until 'Final Entry' button pressed.
btn = -1
Do While btn = -1
'#Select next empty cell
	pm.ActiveCell.Item(2, 1).Select
'#Show Dialog
	dlg.Drop1 = 0
	dlg.Drop2 = 0
	dlg.TxtBox1 = ""
	dlg.TxtBox3 = ""
	dlg.TxtBox4 = ""
	btn = Dialog (dlg)

'#Move down one cell for next entry
'	If btn = 3 Then
'		pm.ActiveCell.Item(2, 1).Select
'	End If

'#Put items in sheet if 'OK' button
	If (btn = -1) OR (btn = 3) Then
		If dlg.Drop1 <> 0 Then			
			pm.ActiveCell.Value = ItemList(dlg.Drop1) & " " & dlg.TxtBox4
			pm.Activecell.Item(1,2).Value = Dlg.TxtBox2
			If (dlg.Drop1 = 4) OR (dlg.Drop1 = 7) Then
				pm.ActiveCell.Item(1,5).Value = Dlg.TxtBox1
			Else
				pm.ActiveCell.Item(1,3).Value = Dlg.TxtBox1
			End If
			
		ElseIf dlg.Drop2 > 1 Then
'#Take payment from Accumulated on Data Sheet
			pm.ActiveWorkbook.Sheets("Data").Activate
			pm.Range("A12").Item(Dlg.Drop2, 6).Select
			If pm.ActiveCell.Value > Val(dlg.TxtBox1) Then
				pm.ActiveCell.Value = pm.ActiveCell.Value - dlg.TxtBox1
				money = dlg.TxtBox1
			Else
'#Take what there is
				money = pm.ActiveCell.Value
				pm.ActiveCell.Value = 0
			End If
'#Return to Month
			pm.ActiveWorkbook.Sheets(EntryMonth).Activate
			pm.ActiveCell.Value = PayList(dlg.Drop2)
			pm.Activecell.Item(1,2).Value = Dlg.TxtBox2
			pm.ActiveCell.Item(1,3).Value = Dlg.TxtBox1
			pm.ActiveCell.Item(1,4).Value = money
'#Adjust B balance
		ElseIf dlg.Drop2 = 1 Then
			pm.ActiveCell.Item(1,5).Value = Dlg.TxtBox1 *-1
		End If
	End If
Loop
'******************************************************
'END OF PROGRAM
'******************************************************
'******************************************************
'DIALOG FUNCTION
'******************************************************
Function dlgFunc(ControlID$, Action%, SuppValue%)

	Select Case Action
	Case 1
	
	Case 2
'#Ensure only one list used
		If ControlID$ = "Drop1" Then
			dlgEnable "Drop2", 0
		ElseIf ControlID$ = "Drop2" Then
			dlgEnable "Drop1", 0
		End If

'#Prevent these buttons from closing Dialog
		If ControlID$ = "btn1" Then
			dlgFunc = 1
			epoch = epoch -1
			dlgText "TxtBox2", Format(epoch,"dd"&"/"&"mm"&"/"&"yyyy")
		ElseIf ControlID$ = "btn2" Then
			dlgFunc = 1
			epoch = epoch +1
			dlgText "TxtBox2", Format(epoch,"dd"&"/"&"mm"&"/"&"yyyy")
		End If

'#Make sure all fields are filled
		If (SuppValue = 1) OR (ControlID$ = "btn3") Then 
			If Dlg.TxtBox1 = "" Then 
				DlgText "TxtBox3", "* Enter an amount *"
				dlgFunc = 1
			ElseIf (dlg.Drop1 = 0) And (dlg.Drop2 =  0) Then
				DlgText "TxtBox3", "* Select an Item *"
				dlgFunc = 1
			Else
				dlgFunc = 0
			End If
		End If
	End Select
End Function

'******************************************************
UPDATE
'******************************************************
Sub Update()
	Dim daynum As Integer, Temp
	
'#For each missing day.
  	Do While count > 0
		count = count -1
		pm.Range("LastUpdate").Value = pm.Range("PlusDay").Value
		EntryMonth = Format(pm.Range("LastUpdate").Value, "mmm")	 
		EntryDate = pm.Range("LastUpdate").Value
'#P -----Set date to loop date if due----------------------
		daynum = Weekday(EntryDate)
'#Is update day a Monday? 
		If daynum = 2 Then
      	pm.ActiveSheet.Range("Pens_D").Item(1, 3).Value = Day(EntryDate)
    	End If
'------------------------------------------
'#Is update day a Friday? Is it the 4th Friday, if so set 0 for update, or add -1
    	If daynum = 6 Then
      	If pm.Range("Pens_M").Item(1, 4).Value = -3 Then
        		pm.Range("Pens_M").Item(1, 4).Value = 0
        		pm.Range("Pens_M").Item(1, 3).Value = Day(pm.Range("LastUpdate").Value)
      	Else
        		pm.Range("Pens_M").Item(1, 4).Value = pm.Range("Pens_M").Item(1, 4).Value - 1
      	End If
		End If
'------------------------------------------
'#Select Top of Data Item column ready for scan
    pm.Range("A2").Select

    ' Repeat until blank item
    Do Until pm.ActiveCell.Value = ""
    'Check due date is the same as loop date, i.e. due
      If pm.ActiveCell.Item(1, 4).Value = Day(pm.Range("LastUpdate").Value) Then
        item = pm.ActiveCell.Value
        valu = pm.ActiveCell.Item(1, 2).Value
        inout = pm.ActiveCell.Item(1, 3).Value
'------------------------------------------
'#Check if item is B R or not
        If inout = 10 Then
          Blue = 4
        Else
          Blue = 0
        End If
'------------------------------------------
'#Copy due item data to appropriate month
   	  CopyData  
      End If
'------------------------------------------
'#Next vertical cell down
      pm.ActiveCell.Item(2, 1).Select
    Loop
'------------------------------------------
 	Loop
End Sub
'******************************************************
'COPYDATA
'******************************************************
Sub CopyData()
'#UPDATE Current Month
'#Activate worksheet required
    pm.ActiveWorkbook.Sheets(EntryMonth).Activate
    
'MONTH SHEET=============================================================
'#Find first empty cell
  	pm.Range("A2").Select
 	 Do Until pm.ActiveCell.Value = ""
 	   pm.ActiveCell.Item(2, 1).Select
	 Loop
'------------------------------------------    
'#Item
 	pm.ActiveCell.Value = item
'#Date
	pm.ActiveCell.Item(1, 2).Value = EntryDate
'#valu to appropriate column. >3 goes to two places, this sheet & Data
	If inout > 3 Then
 	   pm.ActiveCell.Item(1, 3).Value = valu
 	Else
   	pm.ActiveCell.Item(1, inout+1).Value = valu
	End If
'DATA SHEET=============================================================
'#Return to calling worksheet (Data)
 	pm.ActiveWorkBook.Sheets("Data").Activate
'#B R add 4 to value otherwise use value
	If inout > 3 Then
   	pm.ActiveCell.Item(1, inout - 1).Value = pm.ActiveCell.Item(1, inout - 1).Value + valu '+ Blue
  	End If
'------------------------------------------  
  	If item = "Pens_D" Then
    	pm.Range("Pens_D").Item(1, 4).Value = 0
  	End If
'------------------------------------------
  	If item = "Pens_M" Then
    	pm.Range("Pens_M").Item(1, 4).Value = 0
  	End If
End Sub



'******************************************************
'TRANSFER
'******************************************************