LinkBack Thread Tools Search this Thread Display Modes
Prev Previous Post   Next Post Next
  #1   Report Post  
Posted to microsoft.public.excel.misc
Tdp Tdp is offline
external usenet poster
 
Posts: 74
Default 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
 
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
error in programme biker man Excel Discussion (Misc queries) 4 July 26th 07 09:01 PM
Salary programme Suresh Lohar Excel Discussion (Misc queries) 1 April 3rd 06 07:57 PM
Referencing other programme GBH99 Setting up and Configuration of Excel 1 February 28th 06 10:06 PM
Linking with other programme Rao Ratan Singh New Users to Excel 1 January 31st 06 07:16 PM
Can't access programme hol015 Excel Discussion (Misc queries) 1 August 1st 05 01:14 AM


All times are GMT +1. The time now is 11:30 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"