Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.misc
|
|||
|
|||
![]()
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 |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
error in programme | Excel Discussion (Misc queries) | |||
Salary programme | Excel Discussion (Misc queries) | |||
Referencing other programme | Setting up and Configuration of Excel | |||
Linking with other programme | New Users to Excel | |||
Can't access programme | Excel Discussion (Misc queries) |