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
 
Sort by date Sort by votes
Thank you both.
I note your comments and will remember them for the future.

P.S.
Just "Liked" replies, as apposed to "Solved" as I've not actually applied any at this point.
 
Upvote 0

Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce
Just for kicks, I edited as per my style although the array approach might be more appealing to anyone. Note that this won't run or compile for me as there are issues, and I'm surprised if it runs or compiles for you. The problems seems to be
- the use of Me (didn't know that was allowed in Excel; regardless I don't have a reference to Me anyway)
- your use of .Cells suggests to me that a range reference should be at the beginning of a With block. You don't have one, so I don't see how you get away with that.
- not assigning a value to LastRow. I have to think that is a module level variable that you've set before this code runs.

I might have messed up the associations you had regarding what happens to a particular cell or control, but the code should be close enough to demonstrate the approach I mentioned. That is, anything that was the same regardless of the If test was moved outside of the If test (at least that was my intent). You'll also see that the use of a couple of variables shortens the read considerably. You probably don't need .Value for the calendar reference, but I left it in.
VBA Code: 
Sub julhs()
Dim strValue As String, strItem As String

strValue = UserForm5.txtCommentBox.Value
strItem = Me.txtItemValue

If Me.txtInvNo <> "" Then
   .Cells(LastRow, "O") = Format(Me.Calendar1.Value, "mmm/dd")
   .Cells(LastRow, "P").NoteText Text:=strValue
   .Cells(LastRow, "P") = Me.txtInvNo

   Select Case strValue
      Case "Drawings"
         .Cells(LastRow, "U") = strItem
         .Cells(LastRow, "U").NoteText Text:=strValue
      Case "Purshases of Stock / Materials"
         .Cells(LastRow, "V") = strItem
         .Cells(LastRow, "V").NoteText Text:=strValue
      Case "Tool, Weather / Safety equip"
         .Cells(LastRow, "W") = strItem
         .Cells(LastRow, "W").NoteText Text:=UserForm4.txtCommentBox
      Case "Repairs & Renewals"
         .Cells(LastRow, "X") = strItem
         .Cells(LastRow, "X").NoteText Text:=strValue
      Case "Motor Expenses"
         .Cells(LastRow, "Y") = strItem
         .Cells(LastRow, "Y").NoteText Text:=strValue
      Case "Hire Charges"
         .Cells(LastRow, "Z") = strItem
         .Cells(LastRow, "Z").NoteText Text:=strValue
      Case "Liability Insurance"
         .Cells(LastRow, "AA") = strItem
         .Cells(LastRow, "AA").NoteText Text:=UserForm4.txtCommentBox
      Case "N.I cont / TGWU"
         .Cells(LastRow, "AB") = strItem
         .Cells(LastRow, "AB").NoteText Text:=strValue
      Case "Gen Insur Office Postage / Stationary"
         .Cells(LastRow, "AC") = strItem
         .Cells(LastRow, "AC").NoteText Text:=strValue
      Case "Misc"
         .Cells(LastRow, "AD") = strItem
         .Cells(LastRow, "AD").NoteText Text:=strValue
      Case "Acquisition of Assets"
         .Cells(LastRow, "AE") = strItem
         .Cells(LastRow, "AE").NoteText Text:=strValue
      Case "Let Property"
         .Cells(LastRow, "AF") = strItem
         .Cells(LastRow, "AF").NoteText Text:=strValue
      Case "Bank Charges"
         .Cells(LastRow, "AG") = strItem
         .Cells(LastRow, "AG").NoteText Text:=strValue
      Case "Utilities / House"
         .Cells(LastRow, "AH") = strItem
         .Cells(LastRow, "AH").NoteText Text:=strValue
      Case "Income Tax"
         .Cells(LastRow, "AI") = strItem
         .Cells(LastRow, "AI").NoteText Text:=strValue
      Case "Mower Fuel cost"
         .Cells(LastRow, "AJ") = strItem
         .Cells(LastRow, "AJ").NoteText Text:=strValue
      Case Else
         MsgBox "The selected item has no matching Case value."
   End Select

Else
   .Cells(LastRow, "O") = Format(Me.Calendar1.Value, "mmm/dd")
   .Cells(LastRow, "P") = Me.cmbOtherInvoice

End If
   .Cells(LastRow, "Q") = Me.cmbPaymentMethod
   .Cells(LastRow, "R") = Me.cmbSubGroupsList
   .Cells(LastRow, "S") = strItem
   .Cells(LastRow, "S").NoteText Text:=strValue '** This Adds the "Comment" to the relevant column cell

End Sub
I have a feeling that the last 4 lines are in the wrong place though. Problem is, I can't test the flow.
 
Last edited:
Upvote 0
Yes you're assumptions are correct, the variables had been set earlier in the code.
Bear in mind what I posted was "ONLY" a section of the complete code.
I think?? some of your questions/queries can be explained with this;
VBA Code: 
Private Sub cmdAddEntry_Click()
   Dim LastRow      As Long
   Dim LR1          As Long
   Dim wt           As Worksheet  
   Set wt = ThisWorkbook.ActiveSheet
            Application.ScreenUpdating = False
       With wt
         LastRow = .Columns("T:T").Find("Cash Paid", , xlFormulas, xlWhole, xlByRows, xlNext, False).Row
         LR1 = .Range(.Cells(9, "N"), .Cells(LastRow - 1, "AJ")).Find("*", , xlValues, , xlByRows, xlPrevious).Row
                                                   
       If LR1 = LastRow = 0 Then      '(this needs to be 0 otherwise this doesn't work)
           .Range("N" & LR1 + 1 & ":AJ" & LR1 + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
           .Range("N" & LR1 + 1 & ":AJ" & LR1 + 1).FillUp
          LastRow = LR1 + 1
    End If
Which is the "LEAD IN" part to the code I posted in post #1
With regards the use of "Me." , in some earlier parts of my code I simply used "cmb????" and code was not rejected and ran.
But in the section of code I posted for some reason I used, "Me.cmd???" and it worked for me.
At the end of the day I rely a lot of trial and error because I dont know enough, so when I get something to work I leave it as is!!!!

I very much appreciate your help and insight it gives me for the future.
 
Upvote 0
Me refers to the instance of the class that contains the code; I’d guess it’s a userform here.
 
Upvote 0
Going to chance getting reprimanded for this, but here goes!!

There is an annoying glitch with the “Private Sub cmdAddEntry_Click()” section of code below.
If I don’t have the receipt, I simply put “Missing” in column “P”, as opposed to automatically generating the next “gs????” number
Trouble is when I make the next “Entry”; if the last entry in column “P” is “Missing”, it throws out the automatic numbering sequence.

What changes are needed to the code to ignore “Missing”?
Only 3 options for column “P” will be either; “gs????”, Blanc(null value) or “Missing”

Just as a P.S to code I previously posted.
It was just a section of my “Complete” code for the UserForm, I only posted the section that I wanted to address.
VBA Code: 
Private Sub cmdNextInvoiceNumber_Click()
   Dim rng          As Range
   Dim lRow         As Long
   Dim wt           As Worksheet

            Set wt = ThisWorkbook.ActiveSheet
            Set rng = wt.Range("P9:P1000")   
                   On Error GoTo ErrMsg 
   lRow = rng.Find(What:="*", _
                   After:=Range("P9"), _
                   Lookat:=xlPart, _
                   SearchOrder:=xlByRows, _
                   SearchDirection:=xlPrevious, _
                   MatchCase:=False).Row
        txtInvNo.Value = "gs" & Format(Val(Mid(wt.Range("P" & lRow).Value, 3, Len(wt.Range("P" & lRow).Value) - 2)) + 5, "0000")
    Exit Sub
ErrMsg:
  Unload Me
    MsgBox ("Go and manualy put in the first Invoice# in Cell  P9")  
End Sub
 
Upvote 0
Ok figured it out.
Change this line from
VBA Code: 
lRow = rng.Find(What:="*",
To
VBA Code: 
lRow = rng.Find(What:="gs",
 
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