Posts by jbalth

Re: Shorten VBA loop code

Both very helpful, thank you very much!

I just have no idea how to shorten this sort of stuff. The msgbox is used in place of the email code I'll be using, which is working fine. I just need to know how to put this in a loop, all the way to column J. I mean I can do it the long way, but a programmer would laugh at the method I'm using to do this...

Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
'Workbook_SheetCalculate(ByVal Sh As Object)
Dim c As Range


For Each c In Sheets("Data").Range("A3:A3")
    If c.Value < 5 Then
        MsgBox ("Hi") & Range("A2").Value
        
    End If
    
Next c
Dim d As Range


For Each d In Sheets("Data").Range("B3:B3")
    If d.Value < 5 Then
        MsgBox ("Hi") & Range("B2").Value
        
    End If
    
Next d
For Each e In Sheets("Data").Range("C3:C3")
If e.Value < 5 Then
MsgBox ("Hi") & Range("C2").Value
Next e
End If

Re: Can someone please shorten this VBA code for me? For a userform

All good found it!

Each c In .Range("G:G", .Range("G" & Rows.Count).End(xlUp)) 
            If c.Value <> "" Then Me.ComboBox7.AddItem f.Value

Type. Should be c instead of f. obviously missed the keyboard by a fraction!

Thanks

[COLOR="#FF0000"]Moderation Edit : please remember to add code tags to your VBA code[/COLOR]

Re: Can someone please shorten this VBA code for me? For a userform

Thankyou! Unfortunately, I'm getting an object required error.

Any idea?

Hi There,

I've never studied VBA, as a result I tend to do things the long way. Because there are so many combo boxes, this seems to be running slowly.

Could someone let me know if there is a way to speed up this code? It's for a userform that's taking too long to initialise

Thanks Heaps!

Private Sub UserForm_Initialize()
With ComboBox8
.AddItem ("No")
.AddItem ("Yes")
End With
 
 


DTPicker1.SetFocus
With ComboBox4
.AddItem ("Patron")
.AddItem ("Staff")
.AddItem ("Contractor")
End With


With ComboBox3
  Dim c As Range
    
    With Sheets("Lists")
        For Each c In .Range("C:C", .Range("C" & Rows.Count).End(xlUp))
            If c.Value <> "" Then ComboBox3.AddItem c.Value
        Next c
    End With
    
End With
 
With ComboBox1
.AddItem "Male"
.AddItem "Female"
End With
With ComboBox5
.AddItem ("Front")
.AddItem ("Back")
.AddItem ("Both")
End With


With ComboBox6
Dim e As Range
    
    With Sheets("Lists")
        For Each e In .Range("E:E", .Range("E" & Rows.Count).End(xlUp))
            If e.Value <> "" Then ComboBox6.AddItem e.Value
        Next e
    End With
    
End With
With ComboBox2
Dim d As Range
    
    With Sheets("Lists")
        For Each d In .Range("D:D", .Range("D" & Rows.Count).End(xlUp))
            If d.Value <> "" Then ComboBox2.AddItem d.Value
        Next d
    End With
    
End With


With ComboBox7
Dim f As Range
    
    With Sheets("Lists")
        For Each f In .Range("G:G", .Range("G" & Rows.Count).End(xlUp))
            If f.Value <> "" Then ComboBox7.AddItem f.Value
        Next f
    End With
    
End With
 
 
With ComboBox9
Dim h As Range
    
    With Sheets("Lists")
        For Each h In .Range("J:J", .Range("J" & Rows.Count).End(xlUp))
            If h.Value <> "" Then ComboBox9.AddItem h.Value
        Next h
    End With
    
    
    
    
End With
 
End Sub


Private Sub CommandButton1_Click()
 
Dim emptyRow As Long
 
emptyRow = WorksheetFunction.CountA(Range("A:A")) + 1


Cells(emptyRow, 1).Value = DTPicker1.Value
Cells(emptyRow, 2).Value = TextBox1.Value
Cells(emptyRow, 3).Value = ComboBox4.Value
Cells(emptyRow, 4).Value = TextBox3.Value
Cells(emptyRow, 5).Value = DTPicker2.Value
Cells(emptyRow, 6).Value = ComboBox1.Value
Cells(emptyRow, 7).Value = TextBox4.Value
Cells(emptyRow, 8).Value = TextBox5.Value
Cells(emptyRow, 9).Value = TextBox6.Value
Cells(emptyRow, 10).Value = TextBox7.Value
Cells(emptyRow, 11).Value = TextBox8.Value
Cells(emptyRow, 12).Value = ComboBox5.Value
Cells(emptyRow, 13).Value = TextBox10.Value
Cells(emptyRow, 14).Value = TextBox13.Value
Cells(emptyRow, 15).Value = ComboBox2.Value
Cells(emptyRow, 16).Value = ComboBox6.Value
Cells(emptyRow, 17).Value = TextBox14.Value
Cells(emptyRow, 18).Value = ComboBox7.Value
Cells(emptyRow, 19).Value = TextBox15.Value
Cells(emptyRow, 20).Value = ComboBox8.Value
Cells(emptyRow, 21).Value = TextBox16.Value


Dim answer As Integer


answer = MsgBox("Are you sure you want to clear the form?", vbYesNo + vbQuestion, "Clear form")
If answer = vbYes Then
     
   Dim z As Control
 For Each z In UserForm1.Controls
 If TypeName(z) = "TextBox" Then
 z.Value = ""
 End If
 Next z
Call UserForm_Initialize
Else
     'do nothing
End If
End Sub

Hey guys,

In a lot of my macros I use userforms that have drop down boxes - In these drop down boxes the list is compiled from a range. But then, if someone chooses to manually type something different and click Submit/Ok (which then runs another macro) I'll get the subscript out of range 9 error.

Is there a basic error handler code I can add in to stop this from happening as I use a lot of different userforms and this happens for lots of things I use

Essentially, I would like some generic error handler that can help the user from seeing the debug screen when entering a value into the userform that doesn't exist..

Kind Regards,

Julian

Re: Outlook email - Remove duplicate contacts from excel import

Hmm still can't manage to get it to work. It doesn't seem to find it or anything. Maybe I'm not copying or pasting it into the right order or something?

Re: VBA CODE: Delete BOTH duplicate Rows. (Delete duplicate value AND original value)

To make things Clearer. I have a range with
Julian
Julian
Mark
John

I want it to delete both Julian's so it becomes just
Mark
John

Hi guys,

Plenty of code out there to delete duplicate values, I know. But this always keeps the unique value. What I'm wanting to do is delete the duplicate value AND the original value. I've looked up plenty on the internet, but they don't seem to work for me for some reason.

Could someone please help me with this - Don't necessarily worry about the ranges/sheet names, I can change all that.

Thanks heaps!

Re: Outlook email - Remove duplicate contacts from excel import

I'm getting a Run Time 424 Object Required Error - Not sure if I'm using it right, but definitely on the right track as to how I wanted to handle this!

Re: Outlook email - Remove duplicate contacts from excel import

Hi Pike, I'm not that great with VBA, what do you mean by adding code tags to the VBA syntax?

Hey guys, I'm using a macro I found on the internet to import contacts from excel to outlook. I tailored it to suit my sheet and needs and it's working well. The only thing is, if a contact is already in outlook it still creates a new contact with the same details (therefore making it a duplicate). Is there a code to ensure that excel does not import duplicate contacts using VBA?

Here is the code

Sub CommandButton4_Click()


Dim applOutlook As Outlook.Application
Dim nsOutlook As Outlook.Namespace
Dim ciOutlook As Outlook.ContactItem
Dim delItems As Outlook.Items
Dim lLastRow As Long, i As Long, n As Long, c As Long
'determine last data row in the worksheet:
lLastRow = Sheets("Sheet1").Cells(Rows.Count, "E").End(xlUp).Row
'Create a new instance of the Outlook application. Set the Application object as follows:
Set applOutlook = New Outlook.Application
'use the GetNameSpace method to instantiate (ie. create an instance) a NameSpace object variable, to access existing Outlook items. Set the NameSpace object as follows:
Set nsOutlook = applOutlook.GetNamespace("MAPI")
'----------------------------
 
'----------------------------
'post each row's data on a separate contact item form:
For i = 2 To lLastRow
'Use the Application.CreateItem Method to create a new contact Outlook item in the default Contacts folder. Using this method a new contact item is always created in the default Contacts folder.
'create and display a new contact form for input:


Set ciOutlook = applOutlook.CreateItem(olContactItem)


'display the new contact item form:
ciOutlook.Display


'set properties of the new contact item:


With ciOutlook
.FirstName = ActiveSheet.Cells(i, 5)
.LastName = ActiveSheet.Cells(i, 6)
.Email1Address = ActiveSheet.Cells(i, 8)
.MobileTelephoneNumber = ActiveSheet.Cells(i, 7)
End With
 


'close the new contact item form after saving:
ciOutlook.Close olSave
Next i
 
'clear the variables:
Set applOutlook = Nothing
Set nsOutlook = Nothing
Set ciOutlook = Nothing
Set delFolder = Nothing
Set delItems = Nothing


End Sub

Kind Regards,

Julian

Re: Please shorten this code for me

Absolute legend!!!! How does that make it faster? Do you mind explaining?

Re: Please shorten this code for me

Have a look

Re: Please shorten this code for me

In any case, that new code you just wrote FIXES that date changing issue!!! Last question since you've been so helpful, not a big one but just curious. Whenever I load the userform, it takes a good 10-15 seconds to load and freezes excel whilst it does this, I'm assuming because it needs to load the date into all the comboboxes and being 27 of them it may be a slow process. Is there anything that could speed this up? Or just how it is? Thanks again for all your help

Re: Please shorten this code for me

I did think that, but then it made me think, if that was the case - Wouldn't it be adding 1 next to EVERY blank combo box? Which it doesn't do

Re: Please shorten this code for me

Sorry I should have clarified in my last post - The code still works perfectly. Does exactly what I need it to do! Works perfectly.

Its just whilst it also does what its meant to do, its adding +1 to this random date cell for some reason, I literally can see nothing that would affect this!

Re: Please shorten this code for me

Close. What it does it, it finds a name. Example lets say you select skywriter in the combo box. Then it will locate skywriter in range A:A and then put a +1 in the column to the right of your name. Which is why you/I have used the offset(0,1).

That's all working fine. But for some reason, in range A theres a blank cell above all the names and to the right of that blank cell there is a date (e.g 16/03/2016). And whenever I hit submit, it will add 1 to that date - No idea whY!

Re: Please shorten this code for me

Can I just ask skywriter, for some reason it seems to be adding +1 to the date cell, which shouldn't be affected. I have no idea why itd be doing this!

Basically theres a date in cell B2, that it keeps adding 1 to, I have no idea why as there is no value in the cell to the left of it and also no matching value in the comboboxes!! What the!?

Re: Please shorten this code for me

Amazing mate. Thank you so much! I'll be able to use this code for future projects so I really appreciate it.