Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Discussion (Misc queries) > Please check my code!!!!
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.misc
Tdp Tdp is offline
external usenet poster
  
Posts: 74
Default Please check my code!!!!
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
Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.misc
Tdp Tdp is offline
external usenet poster
  
Posts: 74
Default Please check my code!!!!
The problem I am getting it crashes with the following message:
excel has encounted a problem and must close down.
can anyone help!!
--
Tdp


"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
Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Hybrid Mode Hybrid Mode

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
VBA code for the Check Boxes in a form HKS Excel Discussion (Misc queries) 3 June 24th 08 09:42 PM
Have code check cell contents on edit. Andrew Excel Worksheet Functions 1 January 16th 08 04:47 AM
Increase size of a Forms Check Box (click on to enter check mark) 718Satoshi Excel Discussion (Misc queries) 0 August 17th 07 01:52 AM
Check if Conditional Format is True or False / Check cell Color Kevin McCartney Excel Worksheet Functions 5 June 29th 07 11:12 AM
Enable check box in protected sheet + group check boxes Dexxterr Excel Discussion (Misc queries) 4 August 2nd 06 12:00 PM


All times are GMT +1. The time now is 02:44 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"

 

Contact Us ExcelBanter forum home Privacy Statement