PDA

View Full Version : Compressing VBA Code length



D_Rennie
07-06-2009, 12:31 AM
Hello Everybody.

Could I get some imput on Ways of making the code that i use shortened.
All Code used will be used withen, This workbook, And deal with Sheet 1. For my pitucular use.
With Sheet1
Set rSource = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
End With
Set Cl = rSource.Find(Combobox_List_Search.ComboBox1.Value _
& Combobox_List_Search.ComboBox2.Value, LookIn:=xlValues, lookat:=xlWhole) ' Searches For Existing Contact


ThisWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.clear
ThisWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add Key:=Range _
("B1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ThisWorkbook.Worksheets("Sheet1").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With


Those would help me out for now.

Thankyou All,
D_Rennie.

Bob Phillips
07-06-2009, 12:57 AM
Why do you feel a need to shorten that, it is a trivial amount of code?

D_Rennie
07-06-2009, 01:19 AM
I Would like Learn how diffent things can be done in a shorter manner.
There are many pices of code that could be shortened through the aready 1600+ lines there are for this project. I would like learn it in a steep by steep manner.

Thankyou.
D_Rennie

Bob Phillips
07-06-2009, 01:28 AM
I agree that often code, especially if created using the macro recorder, can be shortened, but that code is not an example. You could make it a tad tidier by placing the With at the start, and you could possibly remove a couple of lines by ditching the sort properties that take the default value, but 1 or 2 lines is pointless, and personally I prefer to see those values.

Why not show us some of the real code that needs shortening, where you know there is repetition or superfluous code.

D_Rennie
07-06-2009, 01:45 AM
Ive rewriten a lot of the code to be as short as i can. So a lot of the question may be just to save a line here or there, And some things that simpley cant be done.

Can this go into one line.
If (KeyCode = 8) And (Len(ComboBox1.Text) < 1) Then Call makeCBList
If (KeyCode = 8) And (Len(ComboBox1.Text) < 1) Then TextBox18.SetFocus

Here is the code withen the userform, I've compressed it as much as i could.
Option Explicit
Option Compare Text

Public strPath As String
Dim ufEventsDisabled As Boolean
Dim oShell As Object
Dim sUrl As String

Private Declare Function ShellExecute& Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hwnd As Long, _
ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long)
Const SW_SHOWNORMAL = 1

Private Sub CommandButton4_Click()
Call Macro1 ' not needed ???
End Sub

Private Sub commandbutton1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Call BtnClr
CommandButton1.Font.Bold = False
End Sub
Private Sub commandbutton2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Call BtnClr
CommandButton2.Font.Bold = True
End Sub
Private Sub CmBAdd_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Call BtnClr
CmBAdd.Font.Bold = True
End Sub
Sub BtnClr()
CommandButton1.Font.Bold = False
CommandButton2.Font.Bold = False
CmBAdd.Font.Bold = False
End Sub
Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Call BtnClr
Label1.Visible = False
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub UserForm_Activate()
NoCloseX
End Sub
Private Sub UserForm_Initialize()
ComboBox1.ShowDropButtonWhen = fmShowDropButtonWhenFocus
ComboBox2.ShowDropButtonWhen = fmShowDropButtonWhenFocus
TextBox18.SetFocus
End Sub
'********************************************************************
'COMBOBOX1 + COMPANY
'********************************************************************
Private Sub ComboBox1_Enter()
Call makeCBList
End Sub
Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If ComboBox1.ListIndex = -1 Then ComboBox1.clear
If ComboBox1.MatchFound And (KeyCode = 8) Then ComboBox1.Text = "": Rem Allows Return _
After AutoComplete Item found Otherwise ComboBox1.DropDown Wont Repopulate
If (KeyCode = 8) And (Len(ComboBox1.Text) < 1) Then Call makeCBList
If (KeyCode = 8) And (Len(ComboBox1.Text) < 1) Then TextBox18.SetFocus
ComboBox1.SetFocus
End Sub

Private Sub ComboBox1_Change()
If ComboBox1.Text = "" Then Call makeCBList
If ufEventsDisabled Then Exit Sub
If ComboBox1.ListIndex = -1 Then Call makeCBList
If ComboBox1.MatchFound Then Exit Sub
TextBox18.SetFocus
ComboBox1.SetFocus
End Sub

Private Sub ComboBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
' If ComboBox1.MatchFound Then Call FillNext
' If ComboBox1.Value <> "" Then Call FillNext
End Sub

'********************************************************************
'''''''''' COMBOBOX TWO ''''''''''
'''''''''' FIRST NAME ''''''''''
'********************************************************************

Private Sub ComboBox2_Enter()
Dim aCell As Object

If ComboBox1.Text = "" Then
ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.clear
ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add Key:=Range _
("C1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End If
Me.ComboBox2.List = Worksheets("Sheet1").Range("C1:C100").Value
If ComboBox1.Value <> "" Then Call FillNext
ComboBox2.DropDown
End Sub

Private Sub ComboBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If ComboBox2.MatchFound = True Then Call SearchFind
End Sub

'********************************************************************
'E-Mail &
'WebAddress
'********************************************************************

Private Sub lblEmail_Click()
' Label's caption is the email address:
Dim sEmailAddy As String
sEmailAddy = Me.lblEmail.Caption

ShellExecute 0&, "open", "mailto:" & sEmailAddy, _
vbNullString, vbNullString, SW_SHOWNORMAL
Unload Me
End Sub

Private Sub lblWeb_Click()
' Label's caption is the web address:
sUrl = "http://www." & Me.lblWeb.Caption & "/forum/"
Set oShell = CreateObject("Wscript.Shell")

oShell.Run (sUrl)
End Sub

Private Sub TextBox3_Exit(ByVal Cancel As MSForms.ReturnBoolean)
lblEmail.Caption = TextBox3.Value
TextBox3.Visible = False
End Sub
Private Sub TextBox4_Exit(ByVal Cancel As MSForms.ReturnBoolean)
lblWeb.Caption = TextBox4.Value
TextBox4.Visible = False
End Sub
Private Sub BtnEdit_Click()
If lblEmail.Caption <> "" Then TextBox3.Value = lblEmail.Caption
TextBox3.Visible = True
End Sub
Private Sub CommandButton3_Click()
If lblWeb.Caption <> "" Then TextBox4.Value = lblWeb.Caption
TextBox4.Visible = True
End Sub

'********************************************************************
'Picture Handling
'********************************************************************

Private Sub Label1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
UserForm1.Show
End Sub
Private Sub Image1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Label1.Visible = True
Label1.Font.Bold = False
End Sub
Private Sub label1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Label1.Font.Bold = True
End Sub
Private Sub TextBox1_Change()
Dim FLName As Variant
FLName = TextBox1.Value
If FLName = False Then Exit Sub
Else
Image1.Picture
End If
End Sub
'********************************************************************
'Userform Buttons
'********************************************************************
Private Sub cmbAdd_Click() '*****************
If ComboBox2 <> "" Then Call AddNew 'Add Button
TextBox3.Visible = False '*****************
TextBox4.Visible = False
End Sub
Private Sub CommandButton1_Click() '*****************
Call clear 'New Button
TextBox3.Visible = True '*****************
TextBox4.Visible = True
End Sub
Private Sub CommandButton2_Click() '*****************
'Dim ans As String 'Close button
'ans = msgbox _ '*****************

'ThisWorkbook.Save
Application.Quit
End Sub

'********************************************************************
'Phone Call Handling
'********************************************************************

Private Sub TextBox11_DblClick(ByVal Cancel As MSForms.ReturnBoolean): ' Office Telephone Call
DialPhone Combobox_List_Search.TextBox10, "Office", TextBox10.Value
End Sub
Private Sub TextBox10_DblClick(ByVal Cancel As MSForms.ReturnBoolean): ' Home Telephone Call
DialPhone Combobox_List_Search.TextBox10, "Home", TextBox10.Value
End Sub
Private Sub TextBox9_DblClick(ByVal Cancel As MSForms.ReturnBoolean): ' Mobile Telephone Call
DialPhone Combobox_List_Search.TextBox9, "Mobile", TextBox9.Value
End Sub


The reason i asked the sought question in post 1.
Ive just the exact code through other modules in this project. Changeing only the cloumn referance. And wanted to know a shorted way of writing it withough using its own module and passing variables for the colums referance. Though i quess thats what ill do now.

Thankyou.\
D_Rennie

Bob Phillips
07-06-2009, 01:57 AM
Ive rewriten a lot of the code to be as short as i can. So a lot of the question may be just to save a line here or there, And some things that simpley cant be done.

Saving a line here or there in 1600+ lines is pointless IMO, especially if it reduces readability


Can this go into one line.
If (KeyCode = 8) And (Len(ComboBox1.Text) < 1) Then Call makeCBList
If (KeyCode = 8) And (Len(ComboBox1.Text) < 1) Then TextBox18.SetFocus

It can

If (KeyCode = 8) And (Len(ComboBox1.Text) < 1) Then Call makeCBList: TextBox18.SetFocus

but I wouldn't do that, I would make it even longer myself but reduce the tests



If KeyCode = 8 And Len(ComboBox1.Text) < 1 Then

Call makeCBList
TextBox18.SetFocus
End If

D_Rennie
07-06-2009, 03:37 AM
Thankyou i didnt know it could be done like
If (KeyCode = 8) And (Len(ComboBox1.Text) < 1) Then Call makeCBList: TextBox18.SetFocus


Would you have any suggestion for
Sub AddNew()
Dim c As Range
Dim oCtrl As MSForms.Control
Dim ClAddress As String
Dim Cl As Range
Dim rSource As Range
Dim Ans As String

With Sheet1
Set rSource = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
End With
Set Cl = rSource.Find(Combobox_List_Search.ComboBox1.Value _
& Combobox_List_Search.ComboBox2.Value, LookIn:=xlValues, lookat:=xlWhole) ' Searches For Existing Contact

If Not Cl Is Nothing Then ClAddress = Cl.Address

Do
Ans = msgbox("Update Contact", vbYesNo, "Save Changes")
If Ans = vbNo Then Exit Sub Else

Cl.Value = Combobox_List_Search.ComboBox1.Value + Combobox_List_Search.ComboBox2.Value
Cl.Offset(0, 1).Value = Combobox_List_Search.ComboBox1.Value
Cl.Offset(0, 2).Value = Combobox_List_Search.ComboBox2.Value
Cl.Offset(0, 3).Value = Combobox_List_Search.TextBox20.Value
Cl.Offset(0, 4).Value = Combobox_List_Search.TextBox22.Value
Cl.Offset(0, 5).Value = Combobox_List_Search.TextBox9.Value
Cl.Offset(0, 6).Value = Combobox_List_Search.TextBox10.Value
Cl.Offset(0, 7).Value = Combobox_List_Search.TextBox11.Value
Cl.Offset(0, 8).Value = Combobox_List_Search.TextBox12.Value
Cl.Offset(0, 9).Value = Combobox_List_Search.TextBox17.Value
Cl.Offset(0, 10).Value = Combobox_List_Search.TextBox13.Value
Cl.Offset(0, 11).Value = Combobox_List_Search.TextBox14.Value
Cl.Offset(0, 18).Value = Combobox_List_Search.TextBox15.Value
Cl.Offset(0, 13).Value = Combobox_List_Search.TextBox16.Value
' c.Offset(0, 14).Value = .TextBox5.Value
' C.Offset(0, 15).Value = .TextBox4.Value
Cl.Offset(0, 16).Value = Combobox_List_Search.TextBox18.Value
Cl.Offset(0, 14).Value = Combobox_List_Search.lblEmail.Caption
Cl.Offset(0, 15).Value = Combobox_List_Search.lblWeb.Caption
Cl.Offset(0, 16).Value = Combobox_List_Search.Label1.Caption
Cl.Offset(0, 16).Value = Combobox_List_Search.TextBox18.Value
Set Cl = rSource.FindNext(Cl)
Loop While Not Cl Is Nothing And Cl.Address <> ClAddress
Exit Sub


Ans = msgbox("new Contact", vbYesNo, "Save Changes")
If Ans = vbNo Then Exit Sub Else

Set c = Range("a65536").End(xlUp).Offset(1, 0) 'next empty cell in column A
' Application.ScreenUpdating = False 'speed up, hide task

With Combobox_List_Search 'write userform entries to database
c.Value = .ComboBox1.Value + .ComboBox2.Value
c.Offset(0, 1).Value = .ComboBox1.Value
c.Offset(0, 2).Value = .ComboBox2.Value
c.Offset(0, 3).Value = .TextBox20.Value
c.Offset(0, 4).Value = .TextBox22.Value
c.Offset(0, 5).Value = .TextBox9.Value
c.Offset(0, 6).Value = .TextBox10.Value
c.Offset(0, 7).Value = .TextBox11.Value
c.Offset(0, 8).Value = .TextBox12.Value
c.Offset(0, 9).Value = .TextBox17.Value
c.Offset(0, 10).Value = .TextBox13.Value
c.Offset(0, 11).Value = .TextBox14.Value
c.Offset(0, 18).Value = .TextBox15.Value
c.Offset(0, 13).Value = .TextBox16.Value
' c.Offset(0, 14).Value = .TextBox5.Value
' C.Offset(0, 15).Value = .TextBox4.Value
c.Offset(0, 16).Value = .TextBox18.Value
' c.Offset(0, 16).Value =
' For Each oCtrl In .Controls 'clear the form
' If TypeOf oCtrl Is MSForms.TextBox Then oCtrl.Value = ""
' Next oCtrl
' Combobox_List_Search.ComboBox1.Value = ""
' Combobox_List_Search.ComboBox2.Value = ""
' Combobox_List_Search.TextBox1.Value = ""
End With

ThisWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.clear
ThisWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add Key:=Range _
("B1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ThisWorkbook.Worksheets("Sheet1").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

End Sub

mdmackillop
07-06-2009, 03:38 AM
There is no point in using a variable in this situation

Private Sub TextBox1_Change()
Dim FLName As Variant
FLName = TextBox1.Value
If FLName = False Then Exit Sub
Else
Image1.Picture
End If
End Sub

TextBox1.Value


Use

If TextBox1.Value = False Then Exit Sub



If a variable is used only once in a procedure and is not used elsewhere as global, then only use it if it increases readability.

mdmackillop
07-06-2009, 03:41 AM
Keep your code ordered. It helps prevent errors such as

Cl.Offset(0, 16).Value = Combobox_List_Search.TextBox18.Value
Cl.Offset(0, 14).Value = Combobox_List_Search.lblEmail.Caption
Cl.Offset(0, 15).Value = Combobox_List_Search.lblWeb.Caption
Cl.Offset(0, 16).Value = Combobox_List_Search.Label1.Caption
Cl.Offset(0, 16).Value = Combobox_List_Search.TextBox18.Value

Bob Phillips
07-06-2009, 03:41 AM
Would you have any suggestion for ...

You could use loops, but as there is no contiguity in what is being set you would need to load arrays with the controls and that would obfuscate the code, so would be self-defeating IMO.

Having seen a bit of your code, apart from Malcolm's observations, I don't think there is much that you could reduce in a sensible way, so I would leave it as is.

D_Rennie
07-06-2009, 04:13 AM
Thankyou both, It all helps to build my knoledge.

Withen this i have used TAPI. Seeing that you both know what you are talking about. You may be able to shead some light on the subject, As its beyond my experience.

The issue is using requestmakecall It deals with the dialer.exe interface.
Where the issue's are is the code will only pause for the preset time loop.
If this time is set to long the modem will not hang up the call fast enough, if at the last second the user desides to end the call leaving the called nuber will still be calling.
If set to short there comes issues with not dialing all the numbers and closing windows fully.
At the moment its a fine line between success and falure with this timing. Depending on the speed of ones computer these times will need reconfigering.
I know there is a way to use the tapi structure without the dialer.exe elimanating all these issues. Though that beyond me.
Not a simple thing to deal with. I understand if you dont want to go near it.
Option Explicit

Const WM_CLOSE = &H10
Const WM_DESTROY = &H2
'Const SW_HIDE = 0
Const WM_SETTEXT = &HC
Const WM_COMMAND = &H111
Const VK_RETURN = &HD
Const WM_CHAR = &H102
Const WM_KEYDOWN = &H100
Const WM_KEYUP = &H101
Const VK_SPACE = &H20
Const GW_CHILD As Long = 5
'Const WM_CHAR = 258
Const VK_F10 = &H79
Const VK_F5 = &H74
Const VK_L = &H4C
Const SW_HIDE = 0
Const SW_SHOW = 5

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

'API use Phone Dialer to make call
Private Declare Function tapiRequestMakeCall Lib "TAPI32.DLL" _
(ByVal DestAddress As String, ByVal AppName As String, ByVal CalledParty As String, _
ByVal Comment As String) As Long

'API find applcation by full caption
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long

'API bring Window to foreground
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long

'API set ShowWindow to hide window
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long)

'API send message to application
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Private Declare Function WaitForSingleObject Lib "kernel32" _
(ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long

Private Declare Function CloseHandle Lib "kernel32" _
(ByVal hObject As Long) As Long

Private Declare Function OpenProcess Lib "kernel32" _
(ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long

Private Declare Function GetWindowThreadProcessId Lib "user32" _
(ByVal hwnd As Long, lpdwProcessId As Long) As Long

Private Declare Function TerminateProcess Lib "kernel32" _
(ByVal hProcess As Long, ByVal uExitCode As Long) As Long

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Const INFINITE = -1&
Private Const SYNCHRONIZE = &H100000
'************************************************************************** ****************
'************************************************************************** ****************
'************************************************************************** ****************
Sub DialPhone(strDial As String, PhoneType As String, Name As String) 'Home Phone Number
On Error GoTo HandleErr
Dim varDialWait As Variant
Dim varStart As Variant
Dim lThreadId As Long
Dim lProcessId As Long
Dim ret As Long
Dim lngRetVal As Long
Static blnDialing As Boolean 'Prevent Re-Entry Into Sub While Dialing
Dim strMsg As String
Dim varReturn As Long
Dim lngX As Long
Dim AppCaption As String
Dim hwnd As Long

DoEvents

blnDialing = False
If blnDialing Then Exit Sub

If msgbox(Combobox_List_Search.ComboBox2.Value & " " & Combobox_List_Search.TextBox20.Value & " " _
& vbNewLine & vbNewLine & Name, vbQuestion Or vbYesNo, "Dial " & PhoneType & " Number") _
= vbNo Then Exit Sub Else

lngRetVal = tapiRequestMakeCall(Trim$(strDial), "", "", "") 'Make call to Number Through Dialer.exe
If lngRetVal = 0 Then blnDialing = True 'Exit sub on tapiRequestMakeCall Fail
Call TestPlayWavFile ' Play Dial Sound Message
For lngX = 1 To 10 ' Number of Loop Times For Sleep
DoEvents
Sleep 1000 ' Sleep 1 Second
Next lngX

'hwnd = FindWindow(vbNullString, AppCaption)
hwnd = FindWindow(vbNullString, "Call Status")
If hwnd <> 0 Then Call SendMessage(hwnd, WM_CLOSE, 0&, 0&)
hwnd = FindWindow(vbNullString, "Phone Dialer")
If hwnd <> 0 Then PostMessage hwnd, WM_CLOSE, 0&, 0&
hwnd = FindWindow(vbNullString, "Dialer")
If hwnd <> 0 Then
PostMessage hwnd, WM_KEYDOWN, VK_RETURN, 0
PostMessage hwnd, WM_KEYUP, VK_RETURN, 0
End If

Exit Sub
HandleErr:
Select Case Err.Number
Case 94 'Invalid Use of Null - if double-click on blank, open dialer
msgbox "here" 'Call Shell("c:\windows\dialer.exe", vbNormalFocus)
Exit Sub
Case Else
'modHandler.LogErr ("frm0Telephone"),("Telephone_Numbers_DblClick" )
End Select
'Resume Exit_Here
End Sub

Thankyou.
D_Rennie.

Bob Phillips
07-06-2009, 04:16 AM
Sorry, personally I have never used TAPI.

rbrhodes
07-06-2009, 04:23 AM
hey,

Don't see why a 'With" couldn't be used in the first bit, it is used in the last. Also dropping the default '.Value' cuts a bit of typing:


Do
Ans = MsgBox("Update Contact", vbYesNo, "Save Changes")
If Ans = vbNo Then Exit Sub Else

'//Using 'With' and dropping default '.Value' saves some words...

With Combobox_List_Search
Cl = .ComboBox1 + .ComboBox2
Cl.Offset(0, 1) = .ComboBox1
Cl.Offset(0, 2) = .ComboBox2
'//<snip>
Cl.Offset(0, 8) = .TextBox12
Cl.Offset(0, 9) = .TextBox17
Cl.Offset(0, 16) = .TextBox18
Set Cl = rSource.FindNext(Cl)
Loop While Not Cl Is Nothing And Cl.Address <> ClAddress
Exit Sub
End With

Ans = MsgBox("new Contact", vbYesNo, "Save Changes")
If Ans = vbNo Then Exit Sub Else

Set c = Range("a65536").End(xlUp).Offset(1, 0) 'next empty cell in column A
' Application.ScreenUpdating = False 'speed up, hide task


With Combobox_List_Search
'write userform entries to database
c = .ComboBox1 + .ComboBox2
c.Offset(0, 1) = .ComboBox1

'//<snip>

End With



'
//Using 'With' again...

With ThisWorkbook.Worksheets("Sheet1").AutoFilter.Sort
.SortFields.Clear
.SortFields.Add Key:=Range _
("B1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With



I feel it's actually more readable as I knw wht's nt thr, So to speak.


[EDIT]: Automated phone dialing...? I'm outta here.

D_Rennie
07-06-2009, 05:30 AM
Thankyou All for the Imput, Ive picked up a couple usefull things.

mdmackillop
07-06-2009, 05:30 AM
[EDIT]: Automated phone dialing...? I'm outta here.
me too!

mdmackillop
07-06-2009, 05:34 AM
Hi DR
Does this work?

With Combobox_List_Search
'write userform entries to database
c = .ComboBox1 + .ComboBox2
c.Offset(0, 1) = .ComboBox1
End With

D_Rennie
07-06-2009, 06:27 AM
If what you are asking did the code work as intended.
No there seamed to be a few issues with what ive posted above.

Here is a working example. That does everythink as expected.
Sub AddNew()
Dim c As Range
Dim oCtrl As MSForms.Control
Dim ClAddress As String
Dim Cl As Range
Dim rSource As Range

With Sheet1
Set rSource = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
End With

Set Cl = rSource.Find(Combobox_List_Search.ComboBox1.Value & Combobox_List_Search.ComboBox2.Value, LookIn:=xlValues, lookat:=xlWhole)

If Not Cl Is Nothing Then

ClAddress = Cl.Address

Do
Dim ans As String

ans = msgbox _
("Update Contact", vbYesNo, "Save Changes")

If ans = vbNo Then Exit Sub Else


Cl.Value = Combobox_List_Search.ComboBox1.Value + Combobox_List_Search.ComboBox2.Value
Cl.Offset(0, 1).Value = Combobox_List_Search.ComboBox1.Value
Cl.Offset(0, 2).Value = Combobox_List_Search.ComboBox2.Value
Cl.Offset(0, 3).Value = Combobox_List_Search.TextBox20.Value
Cl.Offset(0, 4).Value = Combobox_List_Search.TextBox22.Value
Cl.Offset(0, 5).Value = Combobox_List_Search.TextBox9.Value
Cl.Offset(0, 6).Value = Combobox_List_Search.TextBox10.Value
Cl.Offset(0, 7).Value = Combobox_List_Search.TextBox11.Value
Cl.Offset(0, 8).Value = Combobox_List_Search.TextBox12.Value
Cl.Offset(0, 9).Value = Combobox_List_Search.TextBox17.Value
Cl.Offset(0, 10).Value = Combobox_List_Search.TextBox13.Value
Cl.Offset(0, 11).Value = Combobox_List_Search.TextBox14.Value
Cl.Offset(0, 18).Value = Combobox_List_Search.TextBox15.Value
Cl.Offset(0, 13).Value = Combobox_List_Search.TextBox16.Value
' c.Offset(0, 14).Value = .TextBox5.Value
' C.Offset(0, 15).Value = .TextBox4.Value
Cl.Offset(0, 16).Value = Combobox_List_Search.TextBox18.Value
Cl.Offset(0, 14).Value = Combobox_List_Search.lblEmail.Caption
Cl.Offset(0, 15).Value = Combobox_List_Search.lblWeb.Caption
Cl.Offset(0, 16).Value = Combobox_List_Search.Label1.Caption
Cl.Offset(0, 16).Value = Combobox_List_Search.TextBox18.Value

Set Cl = rSource.FindNext(Cl)


Loop While Not Cl Is Nothing And Cl.Address <> ClAddress
Exit Sub

End If

ans = msgbox _
("new Contact", vbYesNo, "Save Changes")

If ans = vbNo Then Exit Sub Else

'next empty cell in column A
Set c = Range("a65536").End(xlUp).Offset(1, 0)
' Application.ScreenUpdating = False 'speed up, hide task
'write userform entries to database
With Combobox_List_Search
c.Value = .ComboBox1.Value + .ComboBox2.Value
c.Offset(0, 1).Value = .ComboBox1.Value
c.Offset(0, 2).Value = .ComboBox2.Value
c.Offset(0, 3).Value = .TextBox20.Value
c.Offset(0, 4).Value = .TextBox22.Value
c.Offset(0, 5).Value = .TextBox9.Value
c.Offset(0, 6).Value = .TextBox10.Value
c.Offset(0, 7).Value = .TextBox11.Value
c.Offset(0, 8).Value = .TextBox12.Value
c.Offset(0, 9).Value = .TextBox17.Value
c.Offset(0, 10).Value = .TextBox13.Value
c.Offset(0, 11).Value = .TextBox14.Value
c.Offset(0, 18).Value = .TextBox15.Value
c.Offset(0, 13).Value = .TextBox16.Value
' c.Offset(0, 14).Value = .TextBox5.Value
' C.Offset(0, 15).Value = .TextBox4.Value
c.Offset(0, 16).Value = .TextBox18.Value
' c.Offset(0, 16).Value =

'clear the form
' For Each oCtrl In .Controls
' If TypeOf oCtrl Is MSForms.TextBox Then oCtrl.Value = ""
' Next oCtrl
' Combobox_List_Search.ComboBox1.Value = ""
' Combobox_List_Search.ComboBox2.Value = ""
' Combobox_List_Search.TextBox1.Value = ""


End With

ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.clear
ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add Key:=Range _
("B1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

End Sub


There must be a subtile change between the two that ill look into.

Cheers

D_Rennie
07-06-2009, 07:05 AM
If what you where asking did Dropping the .value form the userform objects.
Ive only just tryed it and it seams not to work withough the . value.

cheers

rbrhodes
07-06-2009, 02:52 PM
Hi,

So Value is the default of cells but not textboxes, Live and learn <g>

Bob Phillips
07-06-2009, 02:59 PM
Works fine for me without .Text or .Value, although I would never leave it the default personally.

D_Rennie
07-06-2009, 08:06 PM
For me i think i would like to keep the .value .text whatever.
Though i didnt know that one could cut it from the code and then it would deal with the defult value.
There is so much that i can learn and input like this helps me alot. 2 1/2 months ago i had never touched excel or vba or any coding.
Im kinda like a iceburg in a knoledge pool. Ill either melt or learn somethink.

Cheers
D_Rennie

Bob Phillips
07-07-2009, 12:33 AM
For me i think i would like to keep the .value .text whatever.
Though i didnt know that one could cut it from the code and then it would deal

Right move IMO.