dss28
Board Regular
- Joined
- Sep 3, 2020
- Messages
- 165
- Office Version
- 2007
- Platform
- Windows
I have a userform which is used for billing as well as task management.
there are several textboxes in the userform but most important for this are:
txb34 (srNo), txb21 (task name), txb7 (Donation), txb37 (schedule on date), txb8 (Qty.), txb9 (total price), txb1 and combobox2 arranged in the order given on the userform in one line.
Data from these texboxes is transfered to a listbox1 and to a sheet "CopyCalenderData" temporarily before transferring selective data to main sheet10 (SatkarmaDonations) and sheet2(CalenderData).
on sheet2, data from txb34, 21, 37, 1 and combobox2 is transferred for each task for monitoring by commandbutton4.
Textbox34 (srNo) contains unique number based on data in sheet2 for each day entry (date wise / no. of task - if it is first task on a day, the new entry will have value 1 , if next entry on same day, it will have value of 2 etc.). the code for this is "Test2" based in a module.
at present the form has capability to save only one task per date per cmd save click which is trnsferred to the listbox1. If the same task is to be repeated for "n" number of times on differenet dates (say same task for 7,15 or 30 consequtive days ) or may be one on every Monday for 7 Mondays etc) -- one on each day, or may every week / every 15 days etc on a particular day etc., then I have to make repetative data entry by selecting different dates in textbox37.
hence i need a code to take care repeatative tasks as mentioned above.
the different codes I am using are as follows:
also the Sr No is assigned by using the following code in module
I need help in devising the code to save same data for "n' no of consecutive dates , or may be every 7th / 15th / 30th etc day repeatation as defined by the user.
thanking you,
there are several textboxes in the userform but most important for this are:
txb34 (srNo), txb21 (task name), txb7 (Donation), txb37 (schedule on date), txb8 (Qty.), txb9 (total price), txb1 and combobox2 arranged in the order given on the userform in one line.
Data from these texboxes is transfered to a listbox1 and to a sheet "CopyCalenderData" temporarily before transferring selective data to main sheet10 (SatkarmaDonations) and sheet2(CalenderData).
on sheet2, data from txb34, 21, 37, 1 and combobox2 is transferred for each task for monitoring by commandbutton4.
Textbox34 (srNo) contains unique number based on data in sheet2 for each day entry (date wise / no. of task - if it is first task on a day, the new entry will have value 1 , if next entry on same day, it will have value of 2 etc.). the code for this is "Test2" based in a module.
at present the form has capability to save only one task per date per cmd save click which is trnsferred to the listbox1. If the same task is to be repeated for "n" number of times on differenet dates (say same task for 7,15 or 30 consequtive days ) or may be one on every Monday for 7 Mondays etc) -- one on each day, or may every week / every 15 days etc on a particular day etc., then I have to make repetative data entry by selecting different dates in textbox37.
hence i need a code to take care repeatative tasks as mentioned above.
the different codes I am using are as follows:
VBA Code:
Option Explicit
Private Sub ListBox1_Change() ' no. of items = listbox row count
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
'On Error Resume Next
If Me.ListBox1.ListCount = "0" Then
Me.CommandButton2.Enabled = False
Me.TextBox15.value = Me.ListBox1.ListCount ' no. of items = listbox row count
UserForm3.CommandButton4.Enabled = True ' save final receipt data
End If
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True
End Sub
Private Sub TextBox20_AfterUpdate()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
If IsDate(Me.TextBox20.text) Then
'Me.TextBox20.text = Format(Me.TextBox20.text, "dd-mm-yyyy")
Me.TextBox20.text = CDate(Me.TextBox20.value)
End If
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True
End Sub
Private Sub UserForm_Activate()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
With Application
Me.Height = .Height
Me.Width = .Width
Me.Top = .Top
Me.Left = .Left
End With
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True
End Sub
Private Sub CommandButton4_Click() ' final save to sheet10 "SatkarmDonations" and sheet2 "calenderdata"
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
Dim i As Long
Dim ws As Worksheet
Dim eR As Long
Dim iRow As Long
Dim eR1 As Long
Dim rowId As Long
Set ws = Sheet10
Dim jRow As Long
Dim j As Long
Dim ws1 As Worksheet
Set ws1 = Sheet2
Dim eR2 As Long
On Error Resume Next
If UserForm3.TextBox22.value = "" Then ' hidden box
iRow = ThisWorkbook.Sheets("SatkarmDonations").Range("A2:A" & Rows.Count).End(xlUp).row + 1
Else
iRow = UserForm3.TextBox22.value
Application.ScreenUpdating = False
End If
With ThisWorkbook.Sheets("SatkarmDonations").Range("A" & iRow)
For i = 0 To ListBox1.ListCount - 1
eR = WorksheetFunction.CountA(ws.Range("B:B")) + 1
eR1 = WorksheetFunction.CountA(ws.Range("A:A")) + 1
ws.Cells(eR1, 1).value = "=Row()-1" ' irow no.
ws.Cells(eR1, 2).value = Year(Now()) ' year now
ws.Cells(eR1, 3).value = UserForm3.TextBox23.value ' cash memo serial no.
ws.Cells(eR, 4).value = ListBox1.Column(6, i) ' Cash memo in Year / No.format
ws.Cells(eR, 5).value = CDate(ListBox1.Column(7, i)) ' receitp date
'
ws.Cells(eR, 6).value = ListBox1.Column(8, i) ' devotee name
ws.Cells(eR, 7).value = ListBox1.Column(9, i) ' contact no.
ws.Cells(eR, 8).value = ListBox1.Column(10, i) ' gotra
ws.Cells(eR, 9).value = ListBox1.Column(11, i) ' address
'======= code to add sequential numbering in column H -- during each transfer -----------
rowId = rowId + 1
ws.Cells(eR, 10).value = rowId
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
ws.Cells(eR, 11).value = ListBox1.Column(0, i) ' satkarm
ws.Cells(eR, 12).value = ListBox1.Column(1, i) ' donation amount
ws.Cells(eR, 13).value = CDate(ListBox1.Column(2, i)) ' satkarm date
' ws.Cells(eR, 14).value = CDate(ListBox1.Column(3, i)) ' to date
ws.Cells(eR, 15).value = ListBox1.Column(4, i) ' qty
ws.Cells(eR, 16).value = ListBox1.Column(5, i) ' total amount
ws.Cells(eR, 17).value = UserForm3.ComboBox1.value ' mode of payment
ws.Cells(eR, 18).value = UserForm3.TextBox12.value ' online /cheque ref no.
ws.Cells(eR, 19).value = CDate(UserForm3.TextBox14.value) ' payment date ref
ws.Cells(eR, 20).value = ThisWorkbook.Sheets("Sheet25").Range("M1").value ' done by
ws.Cells(eR, 21).value = Now() ' date
Next i
End With
ThisWorkbook.Sheets("CalenderData").Activate
'========= code to trasnfer data to calenderData sheet ====================
If UserForm3.TextBox35.value = "" Then ' hidden box
jRow = ThisWorkbook.Sheets("CalenderData").Range("A2:A" & Rows.Count).End(xlUp).row + 1
Else
jRow = UserForm3.TextBox35.value
Application.ScreenUpdating = False
End If
With ThisWorkbook.Sheets("CalenderData").Range("A" & jRow)
For j = 0 To ListBox1.ListCount - 1
eR2 = WorksheetFunction.CountA(ws1.Range("A:A")) + 1
ws1.Cells(eR2, 1).value = "=Row()-1" ' irow no
ws1.Cells(eR2, 2).value = CDate(ListBox1.Column(2, j))
ws1.Cells(eR2, 3).value = ListBox1.Column(15, j) ' Sr No task ColumC
ws1.Cells(eR2, 4).value = ListBox1.Column(8, j) ' devotee name ColumD
ws1.Cells(eR2, 5).value = ListBox1.Column(0, j) ' satkarm ColumE
ws1.Cells(eR2, 6).value = ListBox1.Column(10, j) ' gotra ColumF
ws1.Cells(eR2, 7).value = ListBox1.Column(8, j) & "-" & ListBox1.Column(0, j) ' Name + Satkarm ColumG
ws1.Cells(eR2, 15).value = ThisWorkbook.Sheets("Sheet25").Range("M1").value ' done by
ws1.Cells(eR2, 16).value = Now() ' date
Next j
End With
MsgBox "Donation data saved, click Final Receipt Print now"
UserForm3.CommandButton5.Enabled = True ' print receipt
UserForm3.CommandButton4.Enabled = False ' final save
UserForm3.CommandButton6.Enabled = False ' refresh form
UserForm3.CommandButton1.Enabled = False ' save item
UserForm3.CommandButton7.Enabled = False ' edit item
UserForm3.CommandButton2.Enabled = False ' delete item
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True
End Sub
' asssign serial no. to textbox34 - serial no. of satkarm for calender data sheet
' code to trsnfer data to calender data sheet from userform3 and to assign next sr,no. based on data filter on date and sr. no. column
' serach satkarm sceduled by date on sheet CalenderData and assign new task no. based on column C max value +1
'Private Sub textbox37_Change()
'Private Sub textbox37_AfterUpdate()
'================== step 1 - copy sheet CalenderData to CopycalenderData==============
Private Sub TextBox1_Change() ' step 1
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
With Sheet14
Sheets("CopyCalenderData").Range("A:H").value = ""
Sheets("CopyCalenderData").Range("M1").value = ""
Sheets("CopyCalenderData").Range("O1").value = ""
Sheets("CopyCalenderData").Range("Q1").value = ""
With Sheet2 ' sheet CalenderData
Sheets("CalenderData").Range("A:H").Copy Destination:=Sheets("CopyCalenderData").Range("A1")
End With
End With
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True
End Sub
' --------- step2 ====== through private sub textbox37-change (date) === call SaveToCopyCalenderData =====================
Private Sub TextBox37_Change() ' scheduled on date textbox 37
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
On Error Resume Next
With Sheet14
ThisWorkbook.Sheets("CopyCalenderData").Range("M1").value = CDate(UserForm3.TextBox37.value) ' sheet2
Call Test2 ' code in module 1
End With
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True
End Sub
Private Sub CommandButton1_Click()
'cmd button save data - trasnfer data from all textboxes to listbox1 and to Sheet CopyCalenderData to assign the sr. no. for task in calender
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
Dim myArr() As Variant, X As Variant
Dim n As Long, c As Long
Call SaveToCopyCalenderData ' copy data from frm3 to sheet copycalenderdata
ReDim X(Me.ListBox1.ListCount, 16)
myArr = Array(TextBox21, TextBox7, TextBox37, TextBox6, TextBox8, TextBox9, TextBox18, TextBox20, TextBox1, TextBox2, ComboBox2, TextBox3, ComboBox1, TextBox12, TextBox14, TextBox34)
For n = 0 To UBound(X) - 1
' For c = 0 To 5
For c = 0 To 15
X(n, c) = Me.ListBox1.List(n, c)
Next c
Next n
For n = 0 To 15 ' 16 columns required to be added to listbox
X(UBound(X), n) = myArr(n)
Next n
Me.ListBox1.List = X
'clear form for another line item
ListBox1.TextAlign = fmTextAlignLeft
ListBox1.ColumnHeads = False
ListBox1.ColumnWidths = "175,60,85,0,50,50,70,70,1,1,1,1,1,1,1"
UserForm3.CommandButton4.Enabled = True ' final Bill save button
Me.CommandButton7.Enabled = True ' edit button
UserForm3.CommandButton1.Enabled = False ' save item button
'Call TextBox9Change ' total Rs of a items selected
Me.TextBox15.value = Me.ListBox1.ListCount ' no. of items = listbox row count
With UserForm3
Me.TextBox21 = ""
Me.TextBox7 = ""
Me.TextBox37 = ""
Me.TextBox6 = ""
Me.TextBox8 = ""
Me.TextBox9 = ""
Me.TextBox34 = ""
Me.TextBox36 = ""
Me.CommandButton1.Enabled = False
End With
With Sheet14
ThisWorkbook.Sheets("CopyCalenderData").Range("M1").value = ""
ThisWorkbook.Sheets("CopyCalenderData").Range("O1").value = ""
ThisWorkbook.Sheets("CopyCalenderData").Range("Q1").value = ""
End With
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True
End Sub
Private Sub TextBox8_Change() ' total value of each row in textbox9 = qty x amount,
'call filter data sheet to assign sr no to task in calender data
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
On Error Resume Next
' total amount = qty x donation amount
TextBox9.text = Val(TextBox8.text) * Val(TextBox7.text) ' total value of each row
UserForm3.TextBox34.value = ThisWorkbook.Sheets("CopyCalenderData").Range("Q1").value
CommandButton1.Enabled = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True
End Sub
Sub SaveToCopyCalenderData()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
Dim i As Integer
Dim j As Integer
Dim final As Double
Dim actual As Double
Dim iRow As Long
Sheet14.Activate
final = ThisWorkbook.Sheets("CopyCalenderData").Range("A" & Rows.Count).End(xlUp).Offset(1).row ' sheet14
If UserForm3.TextBox36.value = "" Then ' hidden textbox in donation details frame1
iRow = Sheet14.Range("A" & Rows.Count).End(xlUp).row + 1
Else
iRow = UserForm3.TextBox36.value
End If
With Sheet14.Range("A" & iRow) ' sheet14 = copycalenderdata
.Offset(0, 0).value = "=Row()-1"
Sheet14.Cells(final, 2) = CDate(UserForm3.TextBox37) ' date colB
Sheet14.Cells(final, 3) = Format(UserForm3.TextBox34, "0") ' task No. / sr no colC
Sheet14.Cells(final, 4) = UserForm3.TextBox1 ' devotee name marathi colD
Sheet14.Cells(final, 5) = UserForm3.TextBox21 ' satkarm name colE
Sheet14.Cells(final, 6) = UserForm3.ComboBox2 ' gotra colE
ThisWorkbook.Sheets("CopyCalenderData").Columns(3).NumberFormat = "0" ' sr no columnC
End With
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True
End Subalso the Sr No is assigned by using the following code in module
Code:
Public Sub Test2()
Dim myVar As Long
On Error Resume Next
With ThisWorkbook.Sheets("CopyCalenderData")
ThisWorkbook.Sheets("CopyCalenderData").Range("M1").value = CDate(UserForm3.TextBox37.value) ' sheet2
myVar = .Evaluate("=MAX(IF(B:B=M1,C:C))")
.Range("O1").value = myVar
.Range("Q1").value = 1 + myVar
End With
End Sub
Function fnIsNumber(value) As Boolean
If CStr(value) = "Error 2007" Then '<===== This is the important line
fnIsNumber = False
Else
' fnIsNumber = Evaluate("ISNUMBER(0+""" & Value & """)")
fnIsNumber = Evaluate("=MAX(IF(B:B=M1,C:C))")
End If
End FunctionI need help in devising the code to save same data for "n' no of consecutive dates , or may be every 7th / 15th / 30th etc day repeatation as defined by the user.
thanking you,
