Trying to speed up code/improve coding skills based off of oz grid article

zjamespryor · Mar 11th 2020

Hello,

I'm trying to improve my vba skills and I came out across this article from ozgrid on speeding up macros. I've looked at my own code and cleaned up some things like changing "" into vbNullString, but the two things that I don't know how to use from this article are changing If then into booleans and how not to use "select" with the code that I am running. The code in question is below:

Code

Private Sub CmdBtn_Enter_Click()


Dim CorrectRow, i, q As Long


Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False


For i = 1 To 3




If Me.Controls("ComboBox" & i) <> vbNullString Then


CorrectRow = WorksheetFunction.Match(CInt(DateDiff("d", "Oct 1, 2020", Me.TextBox1)), Sheets(Me.Controls("ComboBox" & i).Value).Range("A2:A213"), 0) - 1 'this is matching the date difference to a reference number on the respective worksheet


With Sheets(Me.Controls("ComboBox" & i).Value)
.Select


For q = 0 To DateDiff("d", "Oct 1, 2020", Me.TextBox1)
.Range("A2").Offset(CorrectRow + q, 3).Select
Do Until ActiveCell.Value = Me.TextBox2 'Loops the cells until the cell equals your text
If ActiveCell.Value = vbNullString Then        'checks blank cells
ActiveCell.Value = Me.TextBox2  'inserts your text if blank
ElseIf ActiveCell.Value <> vbNullString Then   'if its not blank
ActiveCell.Offset(0, 1).Select   'offset the cell by one, allows loop to repeat to find a blank cell
End If
Loop
Next q
End With
End If
Next i


Sheet1.Select


Unload Me


Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

Display More

Thank you for any help!

Justin Doward · Mar 13th 2020

Hi,

I am not a trained programmer, but have rewritten in the way I would achieve it without .select, it may not be what you are after but you should be able to modify to suit:

Code

Private Sub CmdBtn_Enter_Click()

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False

Dim CorrectRow, DD, MyRWs, i, q As Long
Dim ws As Worksheet
Dim c As Range
Dim TB1, TB2, MyRnge As String

TB1 = Me.TextBox1.Value
TB2 = Me.TextBox2.Value
DD = CInt(DateDiff("d", "Oct 1, 2020", TB1))
MsgBox DD

For i = 1 To 3

    If Me.Controls("ComboBox" & i) <> vbNullString Then
        
        Set ws = Sheets(Me.Controls("ComboBox" & i).Value)

        MyRWs = ws.Cells(1, 1).CurrentRegion.Rows.Count
        MyRnge = ws.Range(ws.Cells(2, 1), ws.Cells(MyRWs, 1)).Address
        
       CorrectRow = Application.Match(DD, ws.Range(MyRnge), 0) - 1 'this is matching the date difference to a reference number on the respective worksheet

        With ws
        
            For Each c In .Range(.Cells(CorrectRow + 1, 4), .Cells(CorrectRow + DD, 4)) 'syntax is ws.range(ws.cells(1,1),ws.cells(10,1)) for range A1 to A10 for example
                                      
                If c.Value = vbNullString Then c.Value = TB2 'checks blank cells

            Next c
        
        End With
    
    End If
    
Next i

Unload Me

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.EnableEvents = True

End Sub

Display More

Let me know how you go.

Cheers

Justin

**royUK** · Mar 13th 2020

You are Looping to find TextBox2's Value. This could be replaced with the VBA Find Function. However, your code then checks if the active cell is empty.

Do you mean if the value is not found then enter the value from TextBox2?

zjamespryor · Mar 17th 2020

Hello gents, thank you for the replies!

Quote from royUK

Do you mean if the value is not found then enter the value from TextBox2?

Yes. If the cell is blank, then insert the value from the textbox. If it's not blank, then move to the next cell to the right and do the same.

Justin I'll give your code a go and see if I can get it to work!

**royUK** · Mar 17th 2020

I've made some changes to your code, but to finish I need to understand the loop to find "you did it". Where is the text?

Justin Doward · Mar 17th 2020

Just noticed that line 26:

Code

 CorrectRow = Application.Match(DD, ws.Range(MyRnge), 0) - 1

should be this:

Code

 CorrectRow = Application.Match(DD, ws.Range(MyRnge), 0) + 1

and you can remove line 15:

Code

MsgBox DD

HTH

Justin

**royUK** · Mar 17th 2020

I don't understand your Loops. The main thing to speed up the code would be not to Loop

Justin Doward · Mar 17th 2020

Roy,

He appears to calculate the difference in days between a specific date and your chosen date on the form, matches that number of days in column A then fills a range an equivalent number of days into the future from the chosen date in column D (inserting the value in blank cells, and I just noticed inserting the value into the next empty column if a value already exists in D (or whichever is the next blank column)). Whether this occurs on sheet 1,2 or 3 or all three, is determined by the selection of the comboboxes... Is there a way to achieve that without using loops? I did not include the filling of the next column as I missed that he was changing column in the else, will have a look at getting that to work...

Justin Doward · Mar 17th 2020

I Think changing the if function on line 32 to:

Code

 If c.Value = vbNullString Then
 c.Value = TB2 'checks blank cells
 Else
 ws.Cells(c.Row, c.Column + ws.Range(c.Address).Offset(0, -1).Value).Value = TB2
 End If

gets it there.

**royUK** · Mar 17th 2020

I understand the basics, I just want to know exactly what the code is supposed to do.

Justin Doward · Mar 17th 2020

Fair enough, I would be interested in that too.

Just realised the entire IF function can be replaced with:

Code

ws.Cells(c.Row, c.Column + ws.Range(c.Address).Offset(0, -1).Value).Value = TB2

**royUK** · Mar 17th 2020

I think this is what is required.

Code

Option Explicit


Private Sub CmdBtn_Enter_Click()
Dim rCl As Range
Dim CorrectRow As Long, i As Long, q As Long
Dim lCalc As Long


With Application
lCalc = .Calculation
If lCalc <> 4105 Then      ''/// calculation is not set to Manual
.Calculation = 4105    ''/// set Calculation to Manual
End If
.ScreenUpdating = False
.EnableEvents = False
''/// use error handler to ensure reset if error occurs
On Error GoTo restore




For i = 1 To 3


''/// for comboboxes I would use the ListIndex, -1 indicates no selection made
If Me("ComboBox" & i).ListIndex <> -1 Then
CorrectRow = WorksheetFunction.Match(CInt(DateDiff("d", "Oct 1, 2020", Me.TextBox1)), Sheets(Me.Controls("ComboBox" & i).Value).Range("A2:A213"), 0) - 1    'this is matching the date difference to a reference number on the respective worksheet


With Sheets(Me("ComboBox" & i).Value)
''///no need to select
'        .Select
'                    For q = 0 To DateDiff("d", "Oct 1, 2020", Me.TextBox1)


Set rCl = .Cells(CorrectRow + 2, .Columns.Count).End(xlToLeft).Offset(, 1)
rCl.Value = Me.TextBox2.Value
''/// I don't think the code below is necessary
'                        .Range("A2").Offset(CorrectRow + q, 3).Select
'                        Do Until ActiveCell.Value = Me.TextBox2    'Loops the cells until the cell equals "You did it!"
'                            If ActiveCell.Value = vbNullString Then        'checks blank cells
'                                ActiveCell.Value = Me.TextBox2  'inserts "You did it!" if blank
'                            ElseIf ActiveCell.Value <> vbNullString Then   'if its not blank
'                                ActiveCell.Offset(0, 1).Select   'offset the cell by one, allows loop to repeat to find a blank cell
'                            End If
'                        Loop
'                    Next q
End With
End If
Next i
''///no need to select
'   Sheet1.Select
exit_proc:
Unload Me
Exit Sub
restore:
.Calculation = lCalc
.ScreenUpdating = True
.EnableEvents = True
End With
Resume exit_proc:
End Sub



I've also changed the way the comboboxes load so that it doesn't use Named Ranges

Display More

Justin Doward · Mar 17th 2020

I wondered where the "you did it" you were referring to came from, it looks like he modified the code in the first post after you had copied it out.

**royUK** · Mar 17th 2020

I can't see why? I think my code does what he wants using .Find instead of the Loop and xlToLeft

zjamespryor · Mar 17th 2020

Hello gents, so my "master" workbook is very involved. I have "groups of guests" arriving on certain dates and leaving on other dates. On my master workbook the above code posts both to a sheet with the same name as the value in the combo box and both to a master dates sheet. The master dates sheet is setup in a similar fashion to the sheets in the examples.

I have another sheet setup to look like the month of October. On any given day in October I've set that day's cell equal to the respective cell containing the counta on the master dates sheet. So after a team is added they could look at the month of October and see "oh, there are five groups coming from October 1st to October 4th." The point of it posting into a row is for a macro that will show all the teams coming on that day when ran. So not only can the client see at a glance, "oh there are five groups coming from October 1st to October 4th, but if I click this button I can see the particular teams on October 1st, 2nd etc." The different locations come in so not only can I see what teams are coming in, but also where they'll be staying.

I can give you the "master" if you would like, but it'll be tomorrow at the soonest since I'll have to remove some information.

zjamespryor · Mar 17th 2020

Again, thank you both. I'll try both of these!

Justin Doward · Mar 17th 2020

No need from my perspective to post further detail, but it would be good if you could clarify whether you 1. require code to fill every blank cell in a range, stepping across to the next blank column where required and stopping once you match the textbox value, or 2. whether you just need to find the textbox value and fill the first available column in the matched row... The second I believe you can do without a loop ... the first I would be interested to know if you can achieve without a loop.

**royUK** · Mar 17th 2020

I believe that the intention is to set up something like an appointment. The code that I have posted finds the CurrenttRow then adds two to find the row to write to. It then adds the entry to the next empty cell in that row. No Loops involved.

zjamespryor · Mar 17th 2020

Quote from Justin Doward

No need from my perspective to post further detail, but it would be good if you could clarify whether you 1. require code to fill every blank cell in a range, stepping across to the next blank column where required and stopping once you match the textbox value, or 2. whether you just need to find the textbox value and fill the first available column in the matched row... The second I believe you can do without a loop ... the first I would be interested to know if you can achieve without a loop.

The first. My above code finds the respective reference date (I'm matching a number here because its easier to match than a date), then offsets to the column where it should begin pasting. If it sees that there is no value in the respective cell then it'll paste the text box value. If it sees that there is a value, it'll move one column to the right. If it sees that the textbox has the same value, it'll move down to the next row.

**royUK** · Mar 17th 2020

The code that I posted uses the date not the numbers. I didn't realise if the entry matches to move down to the next row. Why is that, it would be a different date?

Trying to speed up code/improve coding skills based off of oz grid article

Participate now!

Share

Tags

Users Viewing This Thread