code crashing my programme???????

T

Tdp

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
 
S

Sheeloo

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
 
T

tdp

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

Sheeloo

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?
 
T

Tdp

I have posted the file to your e-mail.
--
Tdp


Sheeloo said:
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?
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top