Can this code be shortened?

J

julhs

Active Member
Joined
Dec 3, 2018
Messages
476
Office Version
  1. 2010
Platform
  1. Windows
A large section of the code is just duplicated.
How would I utilise the main section of code from (If Me.cmbMainExpenditureGroups = "Drawings" Then)
for BOTH of the arguments
Essentially the key part is the difference between:-
VBA Code: 
If Me.txtInvNo.Value > "" Then
.Cells(LastRow, "O") = Format(Me.Calendar1.Value, "mmm/dd")
.Cells(LastRow, "P") = Me.txtInvNo.Value
.Cells(LastRow, "Q") = Me.cmbPaymentMethod
.Cells(LastRow, "S") = Me.txtItemValue.Value
.Cells(LastRow, "R") = Me.cmbSubGroupsList
'***** This Adds the "Comment" to the relevant column cell
.Cells(LastRow, "S").NoteText Text:=UserForm5.txtCommentBox.Value
AND
VBA Code: 
Else
.Cells(LastRow, "O") = Format(Me.Calendar1.Value, "mmm/dd")
.Cells(LastRow, "P") = Me.cmbOtherInvoice.Value
.Cells(LastRow, "Q") = Me.cmbPaymentMethod
.Cells(LastRow, "S") = Me.txtItemValue.Value
.Cells(LastRow, "R") = Me.cmbSubGroupsList
'***** This Adds the "Comment" to the relevant column cell
.Cells(LastRow, "S").NoteText Text:=UserForm5.txtCommentBox.Value
Full code is this

VBA Code: 
If Me.txtInvNo.Value > "" Then
.Cells(LastRow, "O") = Format(Me.Calendar1.Value, "mmm/dd")
.Cells(LastRow, "P") = Me.txtInvNo.Value
.Cells(LastRow, "Q") = Me.cmbPaymentMethod
.Cells(LastRow, "S") = Me.txtItemValue.Value
.Cells(LastRow, "R") = Me.cmbSubGroupsList
                '***** This Adds the "Comment" to the relevant column cell
.Cells(LastRow, "S").NoteText Text:=UserForm5.txtCommentBox.Value
                '******* There is an 'ELSE' lower down that handles the statement above
                '******* if it's not TRUE
If Me.cmbMainExpenditureGroups = "Drawings" Then
.Cells(LastRow, "U") = Me.txtItemValue.Value
.Cells(LastRow, "U").NoteText Text:=UserForm5.txtCommentBox.Value
End If

If Me.cmbMainExpenditureGroups = "Purshases of Stock / Materials" Then
.Cells(LastRow, "V") = Me.txtItemValue.Value
.Cells(LastRow, "V").NoteText Text:=UserForm5.txtCommentBox.Value
End If
If Me.cmbMainExpenditureGroups = "Tool, Weather / Safety equip" Then
.Cells(LastRow, "W") = Me.txtItemValue.Value
.Cells(LastRow, "W").NoteText Text:=UserForm4.txtCommentBox.Value
End If
If Me.cmbMainExpenditureGroups = "Repairs & Renewals" Then
.Cells(LastRow, "X") = Me.txtItemValue.Value
.Cells(LastRow, "X").NoteText Text:=UserForm5.txtCommentBox.Value
End If
If Me.cmbMainExpenditureGroups = "Motor Expenses" Then
.Cells(LastRow, "Y") = Me.txtItemValue.Value
.Cells(LastRow, "Y").NoteText Text:=UserForm5.txtCommentBox.Value
End If
If Me.cmbMainExpenditureGroups = "Hire Charges" Then
.Cells(LastRow, "Z") = Me.txtItemValue.Value
.Cells(LastRow, "Z").NoteText Text:=UserForm5.txtCommentBox.Value
End If
If Me.cmbMainExpenditureGroups = "Liability Insurance" Then
.Cells(LastRow, "AA") = Me.txtItemValue.Value
.Cells(LastRow, "AA").NoteText Text:=UserForm4.txtCommentBox.Value
End If
If Me.cmbMainExpenditureGroups = "N.I cont / TGWU" Then
.Cells(LastRow, "AB") = Me.txtItemValue.Value
.Cells(LastRow, "AB").NoteText Text:=UserForm5.txtCommentBox.Value
End If
If Me.cmbMainExpenditureGroups = "Gen Insur Office Postage / Stationary" Then
.Cells(LastRow, "AC") = Me.txtItemValue.Value
.Cells(LastRow, "AC").NoteText Text:=UserForm5.txtCommentBox.Value
End If
If Me.cmbMainExpenditureGroups = "Misc" Then
.Cells(LastRow, "AD") = Me.txtItemValue.Value
.Cells(LastRow, "AD").NoteText Text:=UserForm5.txtCommentBox.Value
End If
If Me.cmbMainExpenditureGroups = "Acquisition of Assets" Then
.Cells(LastRow, "AE") = Me.txtItemValue.Value
.Cells(LastRow, "AE").NoteText Text:=UserForm5.txtCommentBox.Value
End If
If Me.cmbMainExpenditureGroups = "Let Property" Then
.Cells(LastRow, "AF") = Me.txtItemValue.Value
.Cells(LastRow, "AF").NoteText Text:=UserForm5.txtCommentBox.Value
End If
If Me.cmbMainExpenditureGroups = "Bank Charges" Then
.Cells(LastRow, "AG") = Me.txtItemValue.Value
.Cells(LastRow, "AG").NoteText Text:=UserForm5.txtCommentBox.Value
End If
If Me.cmbMainExpenditureGroups = "Utilities / House" Then
.Cells(LastRow, "AH") = Me.txtItemValue.Value
.Cells(LastRow, "AH").NoteText Text:=UserForm5.txtCommentBox.Value
End If
If Me.cmbMainExpenditureGroups = "Income Tax" Then
.Cells(LastRow, "AI") = Me.txtItemValue.Value
.Cells(LastRow, "AI").NoteText Text:=UserForm5.txtCommentBox.Value
End If
If Me.cmbMainExpenditureGroups = "Mower Fuel cost" Then
.Cells(LastRow, "AJ") = Me.txtItemValue.Value
.Cells(LastRow, "AJ").NoteText Text:=UserForm5.txtCommentBox.Value
End If

Else

.Cells(LastRow, "O") = Format(Me.Calendar1.Value, "mmm/dd")
.Cells(LastRow, "P") = Me.cmbOtherInvoice.Value
.Cells(LastRow, "Q") = Me.cmbPaymentMethod
.Cells(LastRow, "S") = Me.txtItemValue.Value
.Cells(LastRow, "R") = Me.cmbSubGroupsList
                      '***** This Adds the "Comment" to the relevant column cell
.Cells(LastRow, "S").NoteText Text:=UserForm5.txtCommentBox.Value

If Me.cmbMainExpenditureGroups = "Drawings" Then
.Cells(LastRow, "U") = Me.txtItemValue.Value
.Cells(LastRow, "U").NoteText Text:=UserForm5.txtCommentBox.Value
End If
If Me.cmbMainExpenditureGroups = "Purshases of Stock / Materials" Then
.Cells(LastRow, "V") = Me.txtItemValue.Value
.Cells(LastRow, "V").NoteText Text:=UserForm5.txtCommentBox.Value
End If
If Me.cmbMainExpenditureGroups = "Tool, Weather / Safety equip" Then
.Cells(LastRow, "W") = Me.txtItemValue.Value
.Cells(LastRow, "W").NoteText Text:=UserForm4.txtCommentBox.Value
End If
If Me.cmbMainExpenditureGroups = "Repairs & Renewals" Then
.Cells(LastRow, "X") = Me.txtItemValue.Value
.Cells(LastRow, "X").NoteText Text:=UserForm5.txtCommentBox.Value
End If
If Me.cmbMainExpenditureGroups = "Motor Expenses" Then
.Cells(LastRow, "Y") = Me.txtItemValue.Value
.Cells(LastRow, "Y").NoteText Text:=UserForm5.txtCommentBox.Value
End If
If Me.cmbMainExpenditureGroups = "Hire Charges" Then
.Cells(LastRow, "Z") = Me.txtItemValue.Value
.Cells(LastRow, "Z").NoteText Text:=UserForm5.txtCommentBox.Value
End If
If Me.cmbMainExpenditureGroups = "Liability Insurance" Then
.Cells(LastRow, "AA") = Me.txtItemValue.Value
.Cells(LastRow, "AA").NoteText Text:=UserForm4.txtCommentBox.Value
End If
If Me.cmbMainExpenditureGroups = "N.I cont / TGWU" Then
.Cells(LastRow, "AB") = Me.txtItemValue.Value
.Cells(LastRow, "AB").NoteText Text:=UserForm5.txtCommentBox.Value
End If
If Me.cmbMainExpenditureGroups = "Gen Insur Office Postage / Stationary" Then
.Cells(LastRow, "AC") = Me.txtItemValue.Value
.Cells(LastRow, "AC").NoteText Text:=UserForm5.txtCommentBox.Value
End If
If Me.cmbMainExpenditureGroups = "Misc" Then
.Cells(LastRow, "AD") = Me.txtItemValue.Value
.Cells(LastRow, "AD").NoteText Text:=UserForm5.txtCommentBox.Value
End If
If Me.cmbMainExpenditureGroups = "Acquisition of Assets" Then
.Cells(LastRow, "AE") = Me.txtItemValue.Value
.Cells(LastRow, "AE").NoteText Text:=UserForm5.txtCommentBox.Value
End If
If Me.cmbMainExpenditureGroups = "Let Property" Then
.Cells(LastRow, "AF") = Me.txtItemValue.Value
.Cells(LastRow, "AF").NoteText Text:=UserForm5.txtCommentBox.Value
End If
If Me.cmbMainExpenditureGroups = "Bank Charges" Then
.Cells(LastRow, "AG") = Me.txtItemValue.Value
.Cells(LastRow, "AG").NoteText Text:=UserForm5.txtCommentBox.Value
End If
If Me.cmbMainExpenditureGroups = "Utilities / House" Then
.Cells(LastRow, "AH") = Me.txtItemValue.Value
.Cells(LastRow, "AH").NoteText Text:=UserForm5.txtCommentBox.Value
End If
If Me.cmbMainExpenditureGroups = "Income Tax" Then
.Cells(LastRow, "AI") = Me.txtItemValue.Value
.Cells(LastRow, "AI").NoteText Text:=UserForm5.txtCommentBox.Value
End If
If Me.cmbMainExpenditureGroups = "Mower Fuel cost" Then
.Cells(LastRow, "AJ") = Me.txtItemValue.Value
.Cells(LastRow, "AJ").NoteText Text:=UserForm5.txtCommentBox.Value
End If
End If
End With
 

Excel Facts

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.
Sort by date Sort by votes
Hi,

I have only Glanced at your code which suggests that you probably could use the listindex property of the combobox control to index which column to place the data.

Not tested & bit of a guess but make a backup of your workbook & try of this update & see if does what you want



Code: 
Sub ShortenCodeMaybe()
    Dim ColumnIndex As Long
    
    ColumnIndex = Me.cmbMainExpenditureGroups.ListIndex + 21
    If ColumnIndex < 21 Then Exit Sub
    
    With Worksheets("Sheet1") '<< amend as required
    
        .Cells(LastRow, "O") = Format(Me.Calendar1.Value, "mmm/dd")
        .Cells(LastRow, "P") = IIf(Len(Me.txtInvNo.Value) > 0, Me.txtInvNo.Value, Me.cmbOtherInvoice.Value)
        .Cells(LastRow, "Q") = Me.cmbPaymentMethod
        .Cells(LastRow, "S") = Me.txtItemValue.Value
        .Cells(LastRow, "R") = Me.cmbSubGroupsList
                        '***** This Adds the "Comment" to the relevant column cell
        .Cells(LastRow, "S").NoteText Text:=Me.txtCommentBox.Value
                    
        .Cells(LastRow, ColumnIndex) = Me.txtItemValue.Value
        .Cells(LastRow, ColumnIndex).NoteText Text:=Me.txtCommentBox.Value
    End With

End Sub

I have assumed that UserForm5 is the active userform & replaced the name with the Me keyword.

If UserForm5 is a different userform to main code then amend code accordingly.

Dave
 
Upvote 0
This code gets rid of most the lines:
VBA Code: 
Sub tt()
lastrow = 10              ' just for my testing delete this line
MecmbMainExpenditureGroups = Cells(1, 1)  ' just for my testing delete this line
nma = Array("Drawings", "Purshases of Stock / Materials", "Tool, Weather / Safety equip", "Repairs & Renewals", "Motor Expenses", "Hire Charges", "Liability Insurance", "N.I cont / TGWU", "Gen Insur Office Postage / Stationary", "Misc", "Acquisition of Assets", "Let Property", "Bank Charges", "Utilities / House", "Income Tax", "Mower Fuel cost")
With ActiveSheet          ' just for my testing delete this line
  colin = WorksheetFunction.Match(MecmbMainExpenditureGroups, nma, 0)  ' change to add the dot back in
  If colin > 0 Then
  .Cells(lastrow, 20 + colin) = "Me.txtItemValue.Value"       ' change to remove the quotes
  .Cells(lastrow, 20 + colin).NoteText Text:="UserForm5.txtCommentBox.Value"  ' change to remove the quotes

 End If
End With             ' just for my testing delete this line
End Sub
 
Upvote 0
Ok have figured out how to use GoTo and Line# so now don’t need to duplicate the main section of code.

Many thanks dmt and offthelp, as yet not tried either but will look at both as other alternatives.

So my full code is now this.
VBA Code: 
If Me.txtInvNo.Value > "" Then
.Cells(LastRow, "O") = Format(Me.Calendar1.Value, "mmm/dd")
.Cells(LastRow, "P") = Me.txtInvNo.Value
.Cells(LastRow, "Q") = Me.cmbPaymentMethod
.Cells(LastRow, "S") = Me.txtItemValue.Value
.Cells(LastRow, "R") = Me.cmbSubGroupsList
                '***** This Adds the "Comment" to the relevant column cell
.Cells(LastRow, "S").NoteText Text:=UserForm5.txtCommentBox.Value
                '******* There is an 'ELSE' lower down that handles the statement above
                '******* if it's not TRUE

line1:      '********************************* Added line
If Me.cmbMainExpenditureGroups = "Drawings" Then
.Cells(LastRow, "U") = Me.txtItemValue.Value
.Cells(LastRow, "U").NoteText Text:=UserForm5.txtCommentBox.Value
End If

If Me.cmbMainExpenditureGroups = "Purshases of Stock / Materials" Then
.Cells(LastRow, "V") = Me.txtItemValue.Value
.Cells(LastRow, "V").NoteText Text:=UserForm5.txtCommentBox.Value
End If
If Me.cmbMainExpenditureGroups = "Tool, Weather / Safety equip" Then
.Cells(LastRow, "W") = Me.txtItemValue.Value
.Cells(LastRow, "W").NoteText Text:=UserForm4.txtCommentBox.Value
End If
If Me.cmbMainExpenditureGroups = "Repairs & Renewals" Then
.Cells(LastRow, "X") = Me.txtItemValue.Value
.Cells(LastRow, "X").NoteText Text:=UserForm5.txtCommentBox.Value
End If
If Me.cmbMainExpenditureGroups = "Motor Expenses" Then
.Cells(LastRow, "Y") = Me.txtItemValue.Value
.Cells(LastRow, "Y").NoteText Text:=UserForm5.txtCommentBox.Value
End If
If Me.cmbMainExpenditureGroups = "Hire Charges" Then
.Cells(LastRow, "Z") = Me.txtItemValue.Value
.Cells(LastRow, "Z").NoteText Text:=UserForm5.txtCommentBox.Value
End If
If Me.cmbMainExpenditureGroups = "Liability Insurance" Then
.Cells(LastRow, "AA") = Me.txtItemValue.Value
.Cells(LastRow, "AA").NoteText Text:=UserForm4.txtCommentBox.Value
End If
If Me.cmbMainExpenditureGroups = "N.I cont / TGWU" Then
.Cells(LastRow, "AB") = Me.txtItemValue.Value
.Cells(LastRow, "AB").NoteText Text:=UserForm5.txtCommentBox.Value
End If
If Me.cmbMainExpenditureGroups = "Gen Insur Office Postage / Stationary" Then
.Cells(LastRow, "AC") = Me.txtItemValue.Value
.Cells(LastRow, "AC").NoteText Text:=UserForm5.txtCommentBox.Value
End If
If Me.cmbMainExpenditureGroups = "Misc" Then
.Cells(LastRow, "AD") = Me.txtItemValue.Value
.Cells(LastRow, "AD").NoteText Text:=UserForm5.txtCommentBox.Value
End If
If Me.cmbMainExpenditureGroups = "Acquisition of Assets" Then
.Cells(LastRow, "AE") = Me.txtItemValue.Value
.Cells(LastRow, "AE").NoteText Text:=UserForm5.txtCommentBox.Value
End If
If Me.cmbMainExpenditureGroups = "Let Property" Then
.Cells(LastRow, "AF") = Me.txtItemValue.Value
.Cells(LastRow, "AF").NoteText Text:=UserForm5.txtCommentBox.Value
End If
If Me.cmbMainExpenditureGroups = "Bank Charges" Then
.Cells(LastRow, "AG") = Me.txtItemValue.Value
.Cells(LastRow, "AG").NoteText Text:=UserForm5.txtCommentBox.Value
End If
If Me.cmbMainExpenditureGroups = "Utilities / House" Then
.Cells(LastRow, "AH") = Me.txtItemValue.Value
.Cells(LastRow, "AH").NoteText Text:=UserForm5.txtCommentBox.Value
End If
If Me.cmbMainExpenditureGroups = "Income Tax" Then
.Cells(LastRow, "AI") = Me.txtItemValue.Value
.Cells(LastRow, "AI").NoteText Text:=UserForm5.txtCommentBox.Value
End If
If Me.cmbMainExpenditureGroups = "Mower Fuel cost" Then
.Cells(LastRow, "AJ") = Me.txtItemValue.Value
.Cells(LastRow, "AJ").NoteText Text:=UserForm5.txtCommentBox.Value
End If

Else

.Cells(LastRow, "O") = Format(Me.Calendar1.Value, "mmm/dd")
.Cells(LastRow, "P") = Me.cmbOtherInvoice.Value
.Cells(LastRow, "Q") = Me.cmbPaymentMethod
.Cells(LastRow, "S") = Me.txtItemValue.Value
.Cells(LastRow, "R") = Me.cmbSubGroupsList
                      '***** This Adds the "Comment" to the relevant column cell
.Cells(LastRow, "S").NoteText Text:=UserForm5.txtCommentBox.Value

Goto line1   'Added this line. Duplicated section  now not needed
End If
 
Upvote 0
Agree that if nothing else, a bunch of GoTo's is not elegant coding. If post 3 code doesn't do what you want (or you don't want to use/modify an array) I'd put what is common outside the IF block:
VBA Code: 
If Me.txtInvNo.Value > "" Then
.Cells(LastRow, "P") = Me.txtInvNo.Value
.Cells(LastRow, "S") = Me.txtItemValue.Value

Else
.Cells(LastRow, "P") = Me.cmbOtherInvoice.Value
.Cells(LastRow, "S") = Me.txtItemValue.Value

'Same in either case, so will run regardless, as long as it doesn't depend on some other test.
.Cells(LastRow, "O") = Format(Me.Calendar1.Value, "mmm/dd")
.Cells(LastRow, "Q") = Me.cmbPaymentMethod
.Cells(LastRow, "R") = Me.cmbSubGroupsList
'***** This Adds the "Comment" to the relevant column cell
.Cells(LastRow, "S").NoteText Text:=UserForm5.txtCommentBox.Value
I'd also replace that whack of If's with a Select Case block. If 2 or more cases will produce the same effect, combine them, as in
VBA Code: 
Select Case cmbMainExpenditureGroups
  Case "Drawings", "Misc"
    'do whatever
 Case 'something
   'do whatever
 Case Else 'not required
End Select
Note that I'm not saying Drawings and Misc results are to be equal. They were simply the shortest values I felt like typing in to illustrate how to combine Case statement tests.
 
Upvote 0
Is there short explanation as to why that is?
The more I do, the more I relise how limited my knowledge is!!!
 
Upvote 0
Thanks everyone.
Seems as though I'm spoult for alternative options to "GoTo", but at monent not tried/implemented any of them.
Assure you I will.!!
But what are the issues with using "GoTo??
 
Upvote 0
Using Goto means that your code doesn’t flow in a linear fashion, but rather tends to jump about, which can make it much harder to troubleshoot. Other than for error handling, there are few instances where Goto is the best solution.
 
Upvote 0
It will work - it's just considered amateurish coding and creates what's known as 'spaghetti code'. Creating a flow that is based solely on the results of tests or environment variables is not only considered to be more professional (that may not be the best word to use here) but usually it's also easier to understand and follow that flow. Also, not all programming languages support it, and it's generally considered best practice to use techniques that are used over as many languages as possible for the sake of habit. Google the term and you'll get about 48 million hits.
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Question Question
VBA Code - Create Log sheet (Errorlog) in case VBA Macro condition is not met
Replies
1
Views
427
Tupe77
T
P
  • Question Question
Turning OFF the visibility of a horizontal (category) axis labels if certain conditions apply
Replies
1
Views
799
NdNoviceHlp
NdNoviceHlp
M
  • Question Question
What am I doing Wrong?
Replies
6
Views
276
MBarrett
M
P
  • Question Question
ListBox Click to textbox & delete row
Replies
0
Views
622
pure vito
P
Ramballah
  • Solved
Finding the first certain value with conditions
2
Replies
18
Views
969
mumps
mumps

Forum statistics

Threads
1,225,149
Messages
6,183,194
Members
453,151
Latest member
Lizamaison

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top