Please shorten this code for me

jbalth · Mar 15th 2016

I've done this code the long way and would like for it to be shortened.

Essentially, just need to use loops to get what I'm trying to achieve, but can't work it out :nono:

Code

Private Sub CommandButton1_Click()


Dim found As Range
Set found = Sheets("Sheet1").Columns("A").Find(what:=ComboBox1.Value, LookIn:=xlValues, lookat:=xlWhole)
Dim found1 As Range
Set found1 = Sheets("Sheet1").Columns("A").Find(what:=ComboBox2.Value, LookIn:=xlValues, lookat:=xlWhole)
Dim found2 As Range
Set found2 = Sheets("Sheet1").Columns("A").Find(what:=ComboBox3.Value, LookIn:=xlValues, lookat:=xlWhole)
Dim found3 As Range
Set found3 = Sheets("Sheet1").Columns("A").Find(what:=ComboBox4.Value, LookIn:=xlValues, lookat:=xlWhole)
Dim found4 As Range
Set found4 = Sheets("Sheet1").Columns("A").Find(what:=ComboBox5.Value, LookIn:=xlValues, lookat:=xlWhole)
Dim found5 As Range
Set found5 = Sheets("Sheet1").Columns("A").Find(what:=ComboBox6.Value, LookIn:=xlValues, lookat:=xlWhole)
Dim found6 As Range
Set found6 = Sheets("Sheet1").Columns("A").Find(what:=ComboBox7.Value, LookIn:=xlValues, lookat:=xlWhole)
Dim found7 As Range
Set found7 = Sheets("Sheet1").Columns("A").Find(what:=ComboBox8.Value, LookIn:=xlValues, lookat:=xlWhole)
Dim found8 As Range
Set found8 = Sheets("Sheet1").Columns("A").Find(what:=ComboBox9.Value, LookIn:=xlValues, lookat:=xlWhole)
Dim found9 As Range
Set found9 = Sheets("Sheet1").Columns("A").Find(what:=ComboBox10.Value, LookIn:=xlValues, lookat:=xlWhole)
Dim found10 As Range
Set found10 = Sheets("Sheet1").Columns("A").Find(what:=ComboBox11.Value, LookIn:=xlValues, lookat:=xlWhole)
Dim found11 As Range
Set found11 = Sheets("Sheet1").Columns("A").Find(what:=ComboBox12.Value, LookIn:=xlValues, lookat:=xlWhole)
Dim found12 As Range
Set found12 = Sheets("Sheet1").Columns("A").Find(what:=ComboBox13.Value, LookIn:=xlValues, lookat:=xlWhole)
Dim found13 As Range
Set found13 = Sheets("Sheet1").Columns("A").Find(what:=ComboBox14.Value, LookIn:=xlValues, lookat:=xlWhole)
Dim found14 As Range
Set found14 = Sheets("Sheet1").Columns("A").Find(what:=ComboBox15.Value, LookIn:=xlValues, lookat:=xlWhole)
Dim found15 As Range
Set found15 = Sheets("Sheet1").Columns("A").Find(what:=ComboBox16.Value, LookIn:=xlValues, lookat:=xlWhole)
Dim found16 As Range
Set found16 = Sheets("Sheet1").Columns("A").Find(what:=ComboBox17.Value, LookIn:=xlValues, lookat:=xlWhole)
Dim found17 As Range
Set found17 = Sheets("Sheet1").Columns("A").Find(what:=ComboBox18.Value, LookIn:=xlValues, lookat:=xlWhole)
Dim found18 As Range
Set found18 = Sheets("Sheet1").Columns("A").Find(what:=ComboBox19.Value, LookIn:=xlValues, lookat:=xlWhole)
Dim found19 As Range
Set found19 = Sheets("Sheet1").Columns("A").Find(what:=ComboBox20.Value, LookIn:=xlValues, lookat:=xlWhole)
Dim found20 As Range
Set found20 = Sheets("Sheet1").Columns("A").Find(what:=ComboBox21.Value, LookIn:=xlValues, lookat:=xlWhole)
Dim found21 As Range
Set found21 = Sheets("Sheet1").Columns("A").Find(what:=ComboBox22.Value, LookIn:=xlValues, lookat:=xlWhole)
Dim found22 As Range
Set found22 = Sheets("Sheet1").Columns("A").Find(what:=ComboBox23.Value, LookIn:=xlValues, lookat:=xlWhole)
Dim found23 As Range
Set found23 = Sheets("Sheet1").Columns("A").Find(what:=ComboBox24.Value, LookIn:=xlValues, lookat:=xlWhole)
Dim found24 As Range
Set found24 = Sheets("Sheet1").Columns("A").Find(what:=ComboBox25.Value, LookIn:=xlValues, lookat:=xlWhole)
Dim found25 As Range
Set found25 = Sheets("Sheet1").Columns("A").Find(what:=ComboBox26.Value, LookIn:=xlValues, lookat:=xlWhole)


Dim found26 As Range
Set found26 = Sheets("Sheet1").Columns("A").Find(what:=ComboBox27.Value, LookIn:=xlValues, lookat:=xlWhole)


   
found.Select
   ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
   ActiveCell = ActiveCell.Value + 1
   
   
   
found1.Select
   ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
   ActiveCell = ActiveCell.Value + 1
   
   
   
found2.Select
   ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
   ActiveCell = ActiveCell.Value + 1
   
   
   
found3.Select
   ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
   ActiveCell = ActiveCell.Value + 1
   
   
   
found4.Select
   ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
   ActiveCell = ActiveCell.Value + 1
   
   
   
found5.Select
   ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
   ActiveCell = ActiveCell.Value + 1
   
   
   
found6.Select
   ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
   ActiveCell = ActiveCell.Value + 1
   
   
   
found7.Select
   ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
   ActiveCell = ActiveCell.Value + 1
   
   
   
found8.Select
   ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
   ActiveCell = ActiveCell.Value + 1
   
   
   
found9.Select
   ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
   ActiveCell = ActiveCell.Value + 1
   
   
   
found10.Select
   ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
   ActiveCell = ActiveCell.Value + 1
   
   
   
found11.Select
   ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
   ActiveCell = ActiveCell.Value + 1
   
   
   
found12.Select
   ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
   ActiveCell = ActiveCell.Value + 1
   
   
   
found13.Select
   ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
   ActiveCell = ActiveCell.Value + 1
   
   
   
found14.Select
   ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
   ActiveCell = ActiveCell.Value + 1
   
   
   
found15.Select
   ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
   ActiveCell = ActiveCell.Value + 1
   
   
   
found16.Select
   ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
   ActiveCell = ActiveCell.Value + 1
   
   
   
found17.Select
   ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
   ActiveCell = ActiveCell.Value + 1
   
   
   
found18.Select
   ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
   ActiveCell = ActiveCell.Value + 1
   
   
   
found19.Select
   ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
   ActiveCell = ActiveCell.Value + 1
   
   
   
found20.Select
   ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
   ActiveCell = ActiveCell.Value + 1
   
   
   
found21.Select
   ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
   ActiveCell = ActiveCell.Value + 1
   
   
   
found22.Select
   ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
   ActiveCell = ActiveCell.Value + 1
   
   
   
found23.Select
   ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
   ActiveCell = ActiveCell.Value + 1
   
   
   
found24.Select
   ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
   ActiveCell = ActiveCell.Value + 1
   
   
   
found25.Select
   ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
   ActiveCell = ActiveCell.Value + 1
   
   
   
found26.Select
   ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
   ActiveCell = ActiveCell.Value + 1
   
   
   
End Sub
Sub Userform_Initialize()
ComboBox1.SetFocus


    Dim c As Range
    
    With Sheets("Sheet1")
        For Each c In .Range("A:A", .Range("A" & Rows.Count).End(xlUp))
            If c.Value <> "" Then ComboBox1.AddItem c.Value
        Next c
    End With
 


    Dim c1 As Range
    
    With Sheets("Sheet1")
        For Each c1 In .Range("A:A", .Range("A" & Rows.Count).End(xlUp))
            If c1.Value <> "" Then ComboBox2.AddItem c1.Value
        Next c1
    End With
    
    
    
    
        Dim c2 As Range
    
    With Sheets("Sheet1")
        For Each c2 In .Range("A:A", .Range("A" & Rows.Count).End(xlUp))
            If c2.Value <> "" Then ComboBox3.AddItem c2.Value
        Next c2
    End With
    
    
    
        Dim c3 As Range
    
    With Sheets("Sheet1")
        For Each c3 In .Range("A:A", .Range("A" & Rows.Count).End(xlUp))
            If c3.Value <> "" Then ComboBox4.AddItem c3.Value
        Next c3
    End With
    
    
    
    
    
    
        Dim c4 As Range
    
    With Sheets("Sheet1")
        For Each c4 In .Range("A:A", .Range("A" & Rows.Count).End(xlUp))
            If c4.Value <> "" Then ComboBox5.AddItem c4.Value
        Next c4
    End With
    
    
    
    
    
    
    
        Dim c5 As Range
    
    With Sheets("Sheet1")
        For Each c5 In .Range("A:A", .Range("A" & Rows.Count).End(xlUp))
            If c5.Value <> "" Then ComboBox6.AddItem c5.Value
        Next c5
    End With
    
    
    
    
    
        Dim c6 As Range
    
    With Sheets("Sheet1")
        For Each c6 In .Range("A:A", .Range("A" & Rows.Count).End(xlUp))
            If c6.Value <> "" Then ComboBox7.AddItem c6.Value
        Next c6
    End With
    
    
    
    
    
        Dim c7 As Range
    
    With Sheets("Sheet1")
        For Each c7 In .Range("A:A", .Range("A" & Rows.Count).End(xlUp))
            If c7.Value <> "" Then ComboBox8.AddItem c7.Value
        Next c7
    End With
    
    
    
    
    
        Dim c8 As Range
    
    With Sheets("Sheet1")
        For Each c8 In .Range("A:A", .Range("A" & Rows.Count).End(xlUp))
            If c8.Value <> "" Then ComboBox9.AddItem c8.Value
        Next c8
    End With
    
    
    
    
    
        Dim c9 As Range
    
    With Sheets("Sheet1")
        For Each c9 In .Range("A:A", .Range("A" & Rows.Count).End(xlUp))
            If c9.Value <> "" Then ComboBox10.AddItem c9.Value
        Next c9
    End With
    
    
    
    
    
        Dim c10 As Range
    
    With Sheets("Sheet1")
        For Each c10 In .Range("A:A", .Range("A" & Rows.Count).End(xlUp))
            If c10.Value <> "" Then ComboBox11.AddItem c10.Value
        Next c10
    End With
    
    
    
    
    
        Dim c11 As Range
    
    With Sheets("Sheet1")
        For Each c11 In .Range("A:A", .Range("A" & Rows.Count).End(xlUp))
            If c11.Value <> "" Then ComboBox12.AddItem c11.Value
        Next c11
    End With
    
    
    
    
    
        Dim c12 As Range
    
    With Sheets("Sheet1")
        For Each c12 In .Range("A:A", .Range("A" & Rows.Count).End(xlUp))
            If c12.Value <> "" Then ComboBox13.AddItem c12.Value
        Next c12
    End With
    
    
    
    
        Dim c13 As Range
    
    With Sheets("Sheet1")
        For Each c13 In .Range("A:A", .Range("A" & Rows.Count).End(xlUp))
            If c13.Value <> "" Then ComboBox14.AddItem c13.Value
        Next c13
    End With
    
    
    
        Dim c14 As Range
    
    With Sheets("Sheet1")
        For Each c14 In .Range("A:A", .Range("A" & Rows.Count).End(xlUp))
            If c14.Value <> "" Then ComboBox14.AddItem c14.Value
        Next c14
    End With
 
        Dim c15 As Range
    
    With Sheets("Sheet1")
        For Each c15 In .Range("A:A", .Range("A" & Rows.Count).End(xlUp))
            If c15.Value <> "" Then ComboBox16.AddItem c15.Value
        Next c15
    End With
 


        Dim c16 As Range
    
    With Sheets("Sheet1")
        For Each c16 In .Range("A:A", .Range("A" & Rows.Count).End(xlUp))
            If c16.Value <> "" Then ComboBox17.AddItem c16.Value
        Next c16
    End With
 


        Dim c17 As Range
    
    With Sheets("Sheet1")
        For Each c17 In .Range("A:A", .Range("A" & Rows.Count).End(xlUp))
            If c17.Value <> "" Then ComboBox18.AddItem c17.Value
        Next c17
    End With
 


        Dim c18 As Range
    
    With Sheets("Sheet1")
        For Each c18 In .Range("A:A", .Range("A" & Rows.Count).End(xlUp))
            If c18.Value <> "" Then ComboBox19.AddItem c18.Value
        Next c18
    End With
 


        Dim c19 As Range
    
    With Sheets("Sheet1")
        For Each c19 In .Range("A:A", .Range("A" & Rows.Count).End(xlUp))
            If c19.Value <> "" Then ComboBox20.AddItem c19.Value
        Next c19
    End With
    
    
    
        Dim c20 As Range
    
    With Sheets("Sheet1")
        For Each c20 In .Range("A:A", .Range("A" & Rows.Count).End(xlUp))
            If c20.Value <> "" Then ComboBox21.AddItem c20.Value
        Next c20
    End With
 
        Dim c21 As Range
    
    With Sheets("Sheet1")
        For Each c21 In .Range("A:A", .Range("A" & Rows.Count).End(xlUp))
            If c21.Value <> "" Then ComboBox22.AddItem c21.Value
        Next c21
    End With


   Dim c22 As Range
    
    With Sheets("Sheet1")
        For Each c22 In .Range("A:A", .Range("A" & Rows.Count).End(xlUp))
            If c22.Value <> "" Then ComboBox23.AddItem c22.Value
        Next c22
    End With
    
       Dim c23 As Range
    
    With Sheets("Sheet1")
        For Each c23 In .Range("A:A", .Range("A" & Rows.Count).End(xlUp))
            If c23.Value <> "" Then ComboBox24.AddItem c23.Value
        Next c23
    End With


   Dim c24 As Range
    
    With Sheets("Sheet1")
        For Each c24 In .Range("A:A", .Range("A" & Rows.Count).End(xlUp))
            If c24.Value <> "" Then ComboBox25.AddItem c24.Value
        Next c24
    End With


   Dim c25 As Range
    
    With Sheets("Sheet1")
        For Each c25 In .Range("A:A", .Range("A" & Rows.Count).End(xlUp))
            If c25.Value <> "" Then ComboBox26.AddItem c25.Value
        Next c25
    End With


   Dim c26 As Range
    
    With Sheets("Sheet1")
        For Each c26 In .Range("A:A", .Range("A" & Rows.Count).End(xlUp))
            If c26.Value <> "" Then ComboBox27.AddItem c26.Value
        Next c26
    End With
 
 
End Sub

Display More

skywriter · Mar 15th 2016

Re: Please shorten this code for me

Try this:

Code

Private Sub CommandButton1_Click()
 Dim y As Long, rngFound As Range
    For y = 1 To 27
        Set rngFound = Sheets("Sheet1").Columns("A").Find(what:=Me.Controls("ComboBox" & y).Value, LookIn:=xlValues, lookat:=xlWhole)
        If Not rngFound Is Nothing Then rngFound.Offset(, 1).Value = rngFound.Value + 1
    Next y
End Sub


Sub UserForm_Initialize()
Dim c As Range, x As Long
    With Sheets("Sheet1")
        For x = 1 To 27
            For Each c In .Range("A:A", .Range("A" & Rows.Count).End(xlUp))
                If c.Value <> "" Then Me.Controls("ComboBox" & x).AddItem c.Value
            Next c
        Next x
    End With
ComboBox1.SetFocus
End Sub

Display More

jbalth · Mar 15th 2016

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.

skywriter · Mar 15th 2016

Re: Please shorten this code for me

My pleasure, thanks for the feedback. :cool:

jbalth · Mar 16th 2016

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!?

skywriter · Mar 16th 2016

Re: Please shorten this code for me

Okay so, for each combobox it's looking for the value that was in the combobox and when it finds that it adds 1 to the value that it found, which would be the same as what was in the combobox and puts that value into the cell 1 column to the right on the same row.

Does that make sense and is that what you want?

jbalth · Mar 16th 2016

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!

jbalth · Mar 16th 2016

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!

skywriter · Mar 16th 2016

Re: Please shorten this code for me

If the cell in column A next to where it's adding 1 is empty, the cause could be that one of your text boxes is empty?

Therefore it's looking for nothing and when it finds it, then it adds 1 to the cell next to it?

This would possibly fix that.

Code

Private Sub CommandButton1_Click()
    Dim y As Long, rngFound As Range
    For y = 1 To 27
        If Me.Controls("ComboBox" & y).Value <> "" Then
            Set rngFound = Sheets("Sheet1").Columns("A").Find(what:=Me.Controls("ComboBox" & y).Value, LookIn:=xlValues, lookat:=xlWhole)
            If Not rngFound Is Nothing Then rngFound.Offset(, 1).Value = rngFound.Value + 1
        End If
    Next y
End Sub

jbalth · Mar 16th 2016

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

jbalth · Mar 16th 2016

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

skywriter · Mar 16th 2016

Re: Please shorten this code for me

Quote from jbalth;767461

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

No it stops looking when it finds the first blank cell, and that same cell will always be the first one it finds.

skywriter · Mar 16th 2016

Re: Please shorten this code for me

Can you upload the workbook so I have something to work with?

After you click reply, then there will be a new button where reply was that says "Go Advanced", click that button then there will be a paperclip icon on the toolbar that wasn't there before. Click that icon and it's pretty much self explanatory from there.

Desensitize your data if you have to, if you have a lot of rows, you can delete most of them and leaving 10 or so should be good.

jbalth · Mar 16th 2016

Re: Please shorten this code for me

Have a look

skywriter · Mar 16th 2016

Re: Please shorten this code for me

This is really fast. :cool:

Code

Sub UserForm_Initialize()
    Dim arrNames, cBox As Control
    With Sheets("Sheet1")
     arrNames = Sheets("Sheet1").Range("A3", .Range("A" & Rows.Count).End(xlUp)).Value
     For Each cBox In Me.Controls
        If TypeName(cBox) = "ComboBox" Then
            cBox.List = arrNames
        End If
     Next cBox
    End With
    ComboBox1.SetFocus
End Sub

Display More

jbalth · Mar 16th 2016

Re: Please shorten this code for me

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

skywriter · Mar 16th 2016

Re: Please shorten this code for me

First I put the values in an array, which you can read faster than you can the individual cells.

Then I assigned the whole array to the combo boxes using .list instead of looping and using .add, it's very fast.

skywriter · Mar 16th 2016

Re: Please shorten this code for me

You should change your other code.
Activating cells is unnecessary and slows your code down.

Code

Private Sub CommandButton1_Click()
    Dim y As Long, rngFound As Range
    For y = 1 To 27
        If Me.Controls("ComboBox" & y).Value <> "" Then
            Set rngFound = Sheets("Sheet1").Columns("A").Find(what:=Me.Controls("ComboBox" & y).Value, LookIn:=xlValues, lookat:=xlWhole)
            If Not rngFound Is Nothing Then rngFound.Offset(, 1) = rngFound.Offset(, 1).Value + 1
        End If
    Next y
End Sub

You could also have an input box pop up asking you how many columns you want to offset and you could update columns farther to the right by just putting a variable in the code where the offset is.

Please shorten this code for me

Participate now!

Share

Users Viewing This Thread