ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Discussion (Misc queries) (https://www.excelbanter.com/excel-discussion-misc-queries/)
-   -   code crashing my programme??????? (https://www.excelbanter.com/excel-discussion-misc-queries/207975-code-crashing-my-programme.html)

Tdp
code crashing my programme???????
 
Can anyone check this code for me.
Try to ignore the textbox/checkbox numbers, there are alot of them and its
complicated to try to number them!!
I'm more interested in the mechanics of the code.

Thank you

Option Explicit
Private Sub CommandButton2_Click()
Dim FoundCell As Range

Application.EnableEvents = False

If Me.ComboBox1.ListIndex = -1 Then
'nothing filled in
Beep
Exit Sub
End If
With Worksheets("customers").Range("A:A")
Set FoundCell = .Cells.Find(what:=Me.ComboBox1.Value, _
After:=.Cells(1), _
LookIn:=xlValues, _
lookat:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False)
End With
If FoundCell Is Nothing Then
'this shouldn't happen!
Beep
Else
Me.TextBox1.Value = FoundCell.Offset(0, 0).Value
Me.TextBox2.Value = FoundCell.Offset(0, 1).Value

If IsDate(FoundCell.Offset(0, 1).Value) Then
Me.TextBox3.Value = Format(FoundCell.Offset(0, 2).Value, "dd-mmm-yy")
Me.TextBox4.Value = Format(FoundCell.Offset(0, 3).Value, "dd-mmm-yy")

Else

Me.TextBox3.Value = ""
Me.TextBox4.Value = ""

End If
Me.ComboBox1.Value = FoundCell.Offset(0, 4).Value
Me.ComboBox2.Value = FoundCell.Offset(0, 5).Value
End If

If Me.ComboBox1.ListIndex = -1 Then
'nothing filled in
Beep
Exit Sub
End If
With Worksheets("customers2").Range("A:A")
Set FoundCell = .Cells.Find(what:=Me.ComboBox1.Value, _
After:=.Cells(1), _
LookIn:=xlValues, _
lookat:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False)
End With
If FoundCell Is Nothing Then
'this shouldn't happen!
Beep
Else

Me.TextBox1.Value = FoundCell.Offset(0, 0).Value
Me.TextBox6.Value = FoundCell.Offset(0, 6).Value

If IsDate(FoundCell.Offset(0, 1).Value) Then
Me.TextBox7.Value = Format(FoundCell.Offset(0, 7).Value, "dd-mmm-yy")
Me.TextBox8.Value = Format(FoundCell.Offset(0, 8).Value, "dd-mmm-yy")

Else

Me.TextBox7.Value = ""
Me.TextBox8.Value = ""

End If
Me.ComboBox13.Value = FoundCell.Offset(0, 9).Value
Me.ComboBox4.Value = FoundCell.Offset(0, 10).Value

End If

End Sub
Private Sub TextBox1_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
TextBox1.Value = UCase(Me.TextBox1.Value)

End Sub
Private Sub TextBox2_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
TextBox2.Value = Format(TextBox2.Value, "dd-mmm-yy")
End Sub
Private Sub TextBox4_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
TextBox4.Value = Format(TextBox4.Value, "dd-mmm-yy")
End Sub

Private Sub CommandButton1_Click()

Dim LastRow As Range

Dim iRow As Long
Dim FirstRow As Long
Dim wks As Worksheet

Set LastRow = Sheet2.Range("a100").End(xlUp)

LastRow.Offset(1, 0).Value = TextBox1.Text
LastRow.Offset(1, 1).Value = TextBox2.Text
LastRow.Offset(1, 2).Value = TextBox3.Text


LastRow.Offset(1, 9).Value = ComboBox2.Text
LastRow.Offset(1, 13).Value = ComboBox3.Text


Set LastRow = Sheet5.Range("a100").End(xlUp)

LastRow.Offset(1, 1).Value = TextBox283.Text
LastRow.Offset(1, 2).Value = TextBox284.Text



LastRow.Offset(1, 9).Value = ComboBox110.Text
LastRow.Offset(1, 13).Value = ComboBox111.Text



For Each wks In Worksheets(Array("customers", "customers2"))
With wks
FirstRow = 2 'headers in row 1
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

For iRow = FirstRow To LastRow Step 1
If Application.CountIf(.Range("a2").EntireColumn, _
..Cells(iRow, "A").Value) 1 Then
'it's a duplicate
..Rows(iRow).Delete
End If
Next iRow
End With
Next wks




MsgBox ("Data has been entered")

Application.EnableEvents = True


End Sub
Private Sub CommandButton3_Click()
Dim LastRow As Range

Dim iRow As Long
Dim FirstRow As Long
Dim wks As Worksheet

Set LastRow = Sheet2.Range("a100").End(xlUp)

LastRow.Offset(1, 0).Value = TextBox1.Text
LastRow.Offset(1, 1).Value = TextBox2.Text


LastRow.Offset(1, 9).Value = ComboBox2.Text
LastRow.Offset(1, 13).Value = ComboBox3.Text


Set LastRow = Sheet5.Range("a100").End(xlUp)

LastRow.Offset(1, 1).Value = TextBox283.Text
LastRow.Offset(1, 2).Value = TextBox284.Text



LastRow.Offset(1, 9).Value = ComboBox110.Text
LastRow.Offset(1, 13).Value = ComboBox111.Text



For Each wks In Worksheets(Array("customers", "customers2"))
With wks
FirstRow = 2 'headers in row 1
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

For iRow = FirstRow To LastRow Step 1
If Application.CountIf(.Range("a2").EntireColumn, _
..Cells(iRow, "A").Value) 1 Then
'it's a duplicate
..Rows(iRow).Delete
End If
Next iRow
End With
Next wks




MsgBox ("Data has been entered Saving and Printing Sheet")

Application.EnableEvents = True




' keybd_event VK_SNAPSHOT, 0, 0, 0
DoEvents
keybd_event VK_LMENU, 0, _
KEYEVENTF_EXTENDEDKEY, 0 ' key down
keybd_event VK_SNAPSHOT, 0, _
KEYEVENTF_EXTENDEDKEY, 0
keybd_event VK_SNAPSHOT, 0, _
KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
keybd_event VK_LMENU, 0, _
KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
DoEvents
Workbooks.Add
Application.Wait Now + TimeValue("00:00:01")
ActiveSheet.PasteSpecial Format:="Bitmap", _
Link:=False, DisplayAsIcon:=False
ActiveSheet.Range("A1").Select
ActiveSheet.PageSetup.Orientation = xlLandscape

ActiveSheet.PageSetup.Zoom = 80

ActiveWindow.SelectedSheets.PrintOut Copies:=1
ActiveWorkbook.Close False

End Sub
Private Sub CommandButton4_Click()
UserForm7.Show
End Sub
--
Tdp

Sheeloo[_3_]
code crashing my programme???????
 
It is tough to check if one does not know what the code does.
Can you send me the file?

Check one thing
'--------------------
For Each wks In Worksheets(Array("customers", "customers2"))
With wks
FirstRow = 2 'headers in row 1
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
'------------------

In the segment above you are assigning a Number to LastRow which has been
declared as a Range object (Dim LastRow As Range)...

Change the declaration to Long
Dim LastRow As Long


"Tdp" wrote:

Can anyone check this code for me.
Try to ignore the textbox/checkbox numbers, there are alot of them and its
complicated to try to number them!!
I'm more interested in the mechanics of the code.

Thank you

Option Explicit
Private Sub CommandButton2_Click()
Dim FoundCell As Range

Application.EnableEvents = False

If Me.ComboBox1.ListIndex = -1 Then
'nothing filled in
Beep
Exit Sub
End If
With Worksheets("customers").Range("A:A")
Set FoundCell = .Cells.Find(what:=Me.ComboBox1.Value, _
After:=.Cells(1), _
LookIn:=xlValues, _
lookat:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False)
End With
If FoundCell Is Nothing Then
'this shouldn't happen!
Beep
Else
Me.TextBox1.Value = FoundCell.Offset(0, 0).Value
Me.TextBox2.Value = FoundCell.Offset(0, 1).Value

If IsDate(FoundCell.Offset(0, 1).Value) Then
Me.TextBox3.Value = Format(FoundCell.Offset(0, 2).Value, "dd-mmm-yy")
Me.TextBox4.Value = Format(FoundCell.Offset(0, 3).Value, "dd-mmm-yy")

Else

Me.TextBox3.Value = ""
Me.TextBox4.Value = ""

End If
Me.ComboBox1.Value = FoundCell.Offset(0, 4).Value
Me.ComboBox2.Value = FoundCell.Offset(0, 5).Value
End If

If Me.ComboBox1.ListIndex = -1 Then
'nothing filled in
Beep
Exit Sub
End If
With Worksheets("customers2").Range("A:A")
Set FoundCell = .Cells.Find(what:=Me.ComboBox1.Value, _
After:=.Cells(1), _
LookIn:=xlValues, _
lookat:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False)
End With
If FoundCell Is Nothing Then
'this shouldn't happen!
Beep
Else

Me.TextBox1.Value = FoundCell.Offset(0, 0).Value
Me.TextBox6.Value = FoundCell.Offset(0, 6).Value

If IsDate(FoundCell.Offset(0, 1).Value) Then
Me.TextBox7.Value = Format(FoundCell.Offset(0, 7).Value, "dd-mmm-yy")
Me.TextBox8.Value = Format(FoundCell.Offset(0, 8).Value, "dd-mmm-yy")

Else

Me.TextBox7.Value = ""
Me.TextBox8.Value = ""

End If
Me.ComboBox13.Value = FoundCell.Offset(0, 9).Value
Me.ComboBox4.Value = FoundCell.Offset(0, 10).Value

End If

End Sub
Private Sub TextBox1_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
TextBox1.Value = UCase(Me.TextBox1.Value)

End Sub
Private Sub TextBox2_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
TextBox2.Value = Format(TextBox2.Value, "dd-mmm-yy")
End Sub
Private Sub TextBox4_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
TextBox4.Value = Format(TextBox4.Value, "dd-mmm-yy")
End Sub

Private Sub CommandButton1_Click()

Dim LastRow As Range

Dim iRow As Long
Dim FirstRow As Long
Dim wks As Worksheet

Set LastRow = Sheet2.Range("a100").End(xlUp)

LastRow.Offset(1, 0).Value = TextBox1.Text
LastRow.Offset(1, 1).Value = TextBox2.Text
LastRow.Offset(1, 2).Value = TextBox3.Text


LastRow.Offset(1, 9).Value = ComboBox2.Text
LastRow.Offset(1, 13).Value = ComboBox3.Text


Set LastRow = Sheet5.Range("a100").End(xlUp)

LastRow.Offset(1, 1).Value = TextBox283.Text
LastRow.Offset(1, 2).Value = TextBox284.Text



LastRow.Offset(1, 9).Value = ComboBox110.Text
LastRow.Offset(1, 13).Value = ComboBox111.Text



For Each wks In Worksheets(Array("customers", "customers2"))
With wks
FirstRow = 2 'headers in row 1
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

For iRow = FirstRow To LastRow Step 1
If Application.CountIf(.Range("a2").EntireColumn, _
.Cells(iRow, "A").Value) 1 Then
'it's a duplicate
.Rows(iRow).Delete
End If
Next iRow
End With
Next wks




MsgBox ("Data has been entered")

Application.EnableEvents = True


End Sub
Private Sub CommandButton3_Click()
Dim LastRow As Range

Dim iRow As Long
Dim FirstRow As Long
Dim wks As Worksheet

Set LastRow = Sheet2.Range("a100").End(xlUp)

LastRow.Offset(1, 0).Value = TextBox1.Text
LastRow.Offset(1, 1).Value = TextBox2.Text


LastRow.Offset(1, 9).Value = ComboBox2.Text
LastRow.Offset(1, 13).Value = ComboBox3.Text


Set LastRow = Sheet5.Range("a100").End(xlUp)

LastRow.Offset(1, 1).Value = TextBox283.Text
LastRow.Offset(1, 2).Value = TextBox284.Text



LastRow.Offset(1, 9).Value = ComboBox110.Text
LastRow.Offset(1, 13).Value = ComboBox111.Text



For Each wks In Worksheets(Array("customers", "customers2"))
With wks
FirstRow = 2 'headers in row 1
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

For iRow = FirstRow To LastRow Step 1
If Application.CountIf(.Range("a2").EntireColumn, _
.Cells(iRow, "A").Value) 1 Then
'it's a duplicate
.Rows(iRow).Delete
End If
Next iRow
End With
Next wks




MsgBox ("Data has been entered Saving and Printing Sheet")

Application.EnableEvents = True




' keybd_event VK_SNAPSHOT, 0, 0, 0
DoEvents
keybd_event VK_LMENU, 0, _
KEYEVENTF_EXTENDEDKEY, 0 ' key down
keybd_event VK_SNAPSHOT, 0, _
KEYEVENTF_EXTENDEDKEY, 0
keybd_event VK_SNAPSHOT, 0, _
KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
keybd_event VK_LMENU, 0, _
KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
DoEvents
Workbooks.Add
Application.Wait Now + TimeValue("00:00:01")
ActiveSheet.PasteSpecial Format:="Bitmap", _
Link:=False, DisplayAsIcon:=False
ActiveSheet.Range("A1").Select
ActiveSheet.PageSetup.Orientation = xlLandscape

ActiveSheet.PageSetup.Zoom = 80

ActiveWindow.SelectedSheets.PrintOut Copies:=1
ActiveWorkbook.Close False

End Sub
Private Sub CommandButton4_Click()
UserForm7.Show
End Sub
--
Tdp

Tdp
code crashing my programme???????
 
Hi sheeloo
OK I'll send you the file, as you said its better that way.
What is the sddress to send to?

"Sheeloo" wrote:

It is tough to check if one does not know what the code does.
Can you send me the file?

Check one thing
'--------------------
For Each wks In Worksheets(Array("customers", "customers2"))
With wks
FirstRow = 2 'headers in row 1
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
'------------------

In the segment above you are assigning a Number to LastRow which has been
declared as a Range object (Dim LastRow As Range)...

Change the declaration to Long
Dim LastRow As Long


"Tdp" wrote:

Can anyone check this code for me.
Try to ignore the textbox/checkbox numbers, there are alot of them and its
complicated to try to number them!!
I'm more interested in the mechanics of the code.

Thank you

Option Explicit
Private Sub CommandButton2_Click()
Dim FoundCell As Range

Application.EnableEvents = False

If Me.ComboBox1.ListIndex = -1 Then
'nothing filled in
Beep
Exit Sub
End If
With Worksheets("customers").Range("A:A")
Set FoundCell = .Cells.Find(what:=Me.ComboBox1.Value, _
After:=.Cells(1), _
LookIn:=xlValues, _
lookat:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False)
End With
If FoundCell Is Nothing Then
'this shouldn't happen!
Beep
Else
Me.TextBox1.Value = FoundCell.Offset(0, 0).Value
Me.TextBox2.Value = FoundCell.Offset(0, 1).Value

If IsDate(FoundCell.Offset(0, 1).Value) Then
Me.TextBox3.Value = Format(FoundCell.Offset(0, 2).Value, "dd-mmm-yy")
Me.TextBox4.Value = Format(FoundCell.Offset(0, 3).Value, "dd-mmm-yy")

Else

Me.TextBox3.Value = ""
Me.TextBox4.Value = ""

End If
Me.ComboBox1.Value = FoundCell.Offset(0, 4).Value
Me.ComboBox2.Value = FoundCell.Offset(0, 5).Value
End If

If Me.ComboBox1.ListIndex = -1 Then
'nothing filled in
Beep
Exit Sub
End If
With Worksheets("customers2").Range("A:A")
Set FoundCell = .Cells.Find(what:=Me.ComboBox1.Value, _
After:=.Cells(1), _
LookIn:=xlValues, _
lookat:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False)
End With
If FoundCell Is Nothing Then
'this shouldn't happen!
Beep
Else

Me.TextBox1.Value = FoundCell.Offset(0, 0).Value
Me.TextBox6.Value = FoundCell.Offset(0, 6).Value

If IsDate(FoundCell.Offset(0, 1).Value) Then
Me.TextBox7.Value = Format(FoundCell.Offset(0, 7).Value, "dd-mmm-yy")
Me.TextBox8.Value = Format(FoundCell.Offset(0, 8).Value, "dd-mmm-yy")

Else

Me.TextBox7.Value = ""
Me.TextBox8.Value = ""

End If
Me.ComboBox13.Value = FoundCell.Offset(0, 9).Value
Me.ComboBox4.Value = FoundCell.Offset(0, 10).Value

End If

End Sub
Private Sub TextBox1_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
TextBox1.Value = UCase(Me.TextBox1.Value)

End Sub
Private Sub TextBox2_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
TextBox2.Value = Format(TextBox2.Value, "dd-mmm-yy")
End Sub
Private Sub TextBox4_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
TextBox4.Value = Format(TextBox4.Value, "dd-mmm-yy")
End Sub

Private Sub CommandButton1_Click()

Dim LastRow As Range

Dim iRow As Long
Dim FirstRow As Long
Dim wks As Worksheet

Set LastRow = Sheet2.Range("a100").End(xlUp)

LastRow.Offset(1, 0).Value = TextBox1.Text
LastRow.Offset(1, 1).Value = TextBox2.Text
LastRow.Offset(1, 2).Value = TextBox3.Text


LastRow.Offset(1, 9).Value = ComboBox2.Text
LastRow.Offset(1, 13).Value = ComboBox3.Text


Set LastRow = Sheet5.Range("a100").End(xlUp)

LastRow.Offset(1, 1).Value = TextBox283.Text
LastRow.Offset(1, 2).Value = TextBox284.Text



LastRow.Offset(1, 9).Value = ComboBox110.Text
LastRow.Offset(1, 13).Value = ComboBox111.Text



For Each wks In Worksheets(Array("customers", "customers2"))
With wks
FirstRow = 2 'headers in row 1
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

For iRow = FirstRow To LastRow Step 1
If Application.CountIf(.Range("a2").EntireColumn, _
.Cells(iRow, "A").Value) 1 Then
'it's a duplicate
.Rows(iRow).Delete
End If
Next iRow
End With
Next wks




MsgBox ("Data has been entered")

Application.EnableEvents = True


End Sub
Private Sub CommandButton3_Click()
Dim LastRow As Range

Dim iRow As Long
Dim FirstRow As Long
Dim wks As Worksheet

Set LastRow = Sheet2.Range("a100").End(xlUp)

LastRow.Offset(1, 0).Value = TextBox1.Text
LastRow.Offset(1, 1).Value = TextBox2.Text


LastRow.Offset(1, 9).Value = ComboBox2.Text
LastRow.Offset(1, 13).Value = ComboBox3.Text


Set LastRow = Sheet5.Range("a100").End(xlUp)

LastRow.Offset(1, 1).Value = TextBox283.Text
LastRow.Offset(1, 2).Value = TextBox284.Text



LastRow.Offset(1, 9).Value = ComboBox110.Text
LastRow.Offset(1, 13).Value = ComboBox111.Text



For Each wks In Worksheets(Array("customers", "customers2"))
With wks
FirstRow = 2 'headers in row 1
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

For iRow = FirstRow To LastRow Step 1
If Application.CountIf(.Range("a2").EntireColumn, _
.Cells(iRow, "A").Value) 1 Then
'it's a duplicate
.Rows(iRow).Delete
End If
Next iRow
End With
Next wks




MsgBox ("Data has been entered Saving and Printing Sheet")

Application.EnableEvents = True




' keybd_event VK_SNAPSHOT, 0, 0, 0
DoEvents
keybd_event VK_LMENU, 0, _
KEYEVENTF_EXTENDEDKEY, 0 ' key down
keybd_event VK_SNAPSHOT, 0, _
KEYEVENTF_EXTENDEDKEY, 0
keybd_event VK_SNAPSHOT, 0, _
KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
keybd_event VK_LMENU, 0, _
KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
DoEvents
Workbooks.Add
Application.Wait Now + TimeValue("00:00:01")
ActiveSheet.PasteSpecial Format:="Bitmap", _
Link:=False, DisplayAsIcon:=False
ActiveSheet.Range("A1").Select
ActiveSheet.PageSetup.Orientation = xlLandscape

ActiveSheet.PageSetup.Zoom = 80

ActiveWindow.SelectedSheets.PrintOut Copies:=1
ActiveWorkbook.Close False

End Sub
Private Sub CommandButton4_Click()
UserForm7.Show
End Sub
--
Tdp

Sheeloo[_3_]
code crashing my programme???????
 
id is to_sheeloo
add @hotmail.com to the id

You can also click on my name to find the email address.

Did you try my suggestion below?

"tdp" wrote:

Hi sheeloo
OK I'll send you the file, as you said its better that way.
What is the sddress to send to?

"Sheeloo" wrote:

It is tough to check if one does not know what the code does.
Can you send me the file?

Check one thing
'--------------------
For Each wks In Worksheets(Array("customers", "customers2"))
With wks
FirstRow = 2 'headers in row 1
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
'------------------

In the segment above you are assigning a Number to LastRow which has been
declared as a Range object (Dim LastRow As Range)...

Change the declaration to Long
Dim LastRow As Long
Tdp

Tdp
code crashing my programme???????
 
I have posted the file to your e-mail.
--
Tdp


"Sheeloo" wrote:

id is to_sheeloo
add @hotmail.com to the id

You can also click on my name to find the email address.

Did you try my suggestion below?

"tdp" wrote:

Hi sheeloo
OK I'll send you the file, as you said its better that way.
What is the sddress to send to?

"Sheeloo" wrote:

It is tough to check if one does not know what the code does.
Can you send me the file?

Check one thing
'--------------------
For Each wks In Worksheets(Array("customers", "customers2"))
With wks
FirstRow = 2 'headers in row 1
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
'------------------

In the segment above you are assigning a Number to LastRow which has been
declared as a Range object (Dim LastRow As Range)...

Change the declaration to Long
Dim LastRow As Long
Tdp


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

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