1

I have a code that I wrote late the other day, however I'm not sure what the issue is that my code runs really slowly when I press the run button. So, how can I make my code run more smoothly, faster, and open a new workbook to "Export file" without closing my userform1? seemingly i see a problem with: label19( running text very slow), one with commnand applicationt ( countdown time ) and one with button Export file ! This is my code in userform1:

Private Sub CommandButton1_Click()
UserForm1.Label5.Caption = Label5.Caption + 1
Label6 = Label4.Caption - Label5.Caption

If UserForm1.Label4.Caption <> 0 Then
Label10 = ((Label5.Caption / Label4.Caption) * 100) & "%"
Else
End If
End Sub

Private Sub CommandButton2_Click()
UserForm1.Label5.Caption = Label5.Caption - 1
Label6 = Label4.Caption - Label5.Caption
If UserForm1.Label4.Caption <> 0 Then
Label10 = ((Label5.Caption / Label4.Caption) * 100) & "%"


Else
End If
End Sub

Private Sub CommandButton5_Click()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("report")
Dim lr As Long
lr = Application.WorksheetFunction.CountA(sh.Range("A:A"))

 
sh.Range("A" & lr + 1).Value = "=ROW()-1"
sh.Range("B" & lr + 1).Value = Me.Label4.Caption
sh.Range("C" & lr + 1).Value = Me.Label5.Caption
sh.Range("D" & lr + 1).Value = Me.Label6.Caption
sh.Range("E" & lr + 1).Value = Me.Label10.Caption
sh.Range("F" & lr + 1).Value = Me.Label1.Caption
sh.Range("G" & lr + 1).Value = Me.Label3.Caption


MsgBox "Data added successfully", vbInformation
sh.Range("A1").Value = "Nber"
sh.Range("B1").Value = "Target"
sh.Range("C1").Value = "Actual"
sh.Range("D1").Value = "Difer"
sh.Range("E1").Value = "RFT"
sh.Range("F1").Value = "AtTime"
sh.Range("G1").Value = "Date"

End Sub

''''export
Private Sub CommandButton4_Click()
  Dim nwb As Workbook
    Set nwb = Workbooks.Add
    ThisWorkbook.Sheets("report").UsedRange.Copy nwb.Sheets(1).Range("A1")
 End Sub

'''Time running
'Dim Berhenti As Boolean
Private Sub Userform_Activate()
Do Until Berhenti
Label1.Caption = Time
Label3.Caption = WorksheetFunction.Text(Date, "[$-0421]DDDD, DD MMMM YYYY")
Label19.Left = Label19.Left - 2
If Label19.Left <= 0 - Label19.Width Then Label19.Left = Me.Width
For i = 1 To 8000000: Next
DoEvents
Loop
End Sub
Private Sub userform_Initialize()
BackColor = RGB(58, 68, 156)
End Sub
Private Sub Userform_QueryClose(cancel As Integer, CloseMode As Integer)
Berhenti = True
End Sub



Private Sub Label4_Click()
UserForm1.Label4.Caption = TextBox1.Text
End Sub

Private Sub TextBox1_Change()
On Error Resume Next
Label4 = TextBox1.Text
Label6 = Label4.Caption - Label5.Caption
Label10 = ((Label5.Caption / Label4.Caption) * 100) & "%"
End Sub

Private Sub CommandButton3_Click()
Run_time
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' code in module:
'''Count down
Sub Run_time()
'Application.ScreenUpdating = False
a = UserForm1.TextBox2.Value
b = UserForm1.TextBox3.Value
C = UserForm1.TextBox4.Value
d = UserForm1.TextBox5.Value
e = UserForm1.TextBox6.Value
f = UserForm1.TextBox7.Value
n = a * 10 * 60 * 60 + b * 60 * 60 + C * 10 * 60 + d * 60 + e * 10 + f
'Unload Me
UserForm1.Show
UserForm1.Label13.Caption = a & b & ":" & C & d & ":" & e & f
For i = 1 To n
UserForm1.Label1.Caption = Time
Application.Wait (Now + #12:00:01 AM#)
UserForm1.Label3.Caption = WorksheetFunction.Text(Date, "[$-0421]DDDD, DD MMMM YYYY")
'''''cuoi

DoEvents
UserForm1.Label19.Left = UserForm1.Label19.Left - 2
If UserForm1.Label19.Left <= 0 - UserForm1.Label19.Width Then UserForm1.Label19.Left = UserForm1.Label19.Width
For J = 1 To 8000000: Next
UserForm1.Label13.Caption = Format(DateAdd("s", -1, UserForm1.Label13.Caption), " hh:mm:ss")
UserForm1.Label15.Width = 156 - 156 * i / n
    'Beep
Next i
End Sub
Iam will
  • 11
  • 1
  • Userform_Activate() i use to running text and show time now and date ! – Iam will Jun 29 '21 at 15:02
  • **1.** What is the purpose of `Userform_Activate()`? That is the only place I see unnnecessary loops. **2.** Also avoid `.UsedRange.Copy`. Find [last row and last column](https://stackoverflow.com/questions/11169445/error-in-finding-last-used-cell-in-excel-with-vba/11169920#11169920) using `.Find` and then construct your range to copy. **3.** I also do not understand the for `Sub Run_time()`, What is the object tive of `Application.Wait`and `For J = 1 To 8000000: Next`. I would recommend just mention the exact logic that you want to follow. i.e what are you trying toi achieve? – Siddharth Rout Jun 29 '21 at 15:04
  • -Application.Waitand --> i use to count donw time -For J = 1 To 8000000 : Next. ---> adjusted speed for running text ! – Iam will Jun 29 '21 at 15:08
  • Sub Run_time() this is my module i create for commandbutton 3 to call count down time – Iam will Jun 29 '21 at 15:10

0 Answers0