Is there any way I shorten the VBA code?

S

shantanu97

New Member
Joined
Aug 27, 2020
Messages
6
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
I have 3 sub routine in my VBA code that I want to shorten.
1.Add New Record
VBA Code: 
.Cells(PasteRow, 12).Value = DEFrm.Cells(11, 2).Value
2.Update Old Record
VBA Code: 
.Cells(WyPtRow, 6).Value = DEFrm.Cells(6, 7).Value
3.Return Found Record
VBA Code: 
.Cells(6, 2).Value = ObsData.Cells(WyPtRow, 2).Value

In the above I just show the snippet how the ACTUAL code looks like. Every subroutine have 50 lines similar to that but just changing the position number. Attach Workbook.

Can anyone help me to reduce those 50 lines of codes?
 

Excel Facts

What is the last column in Excel?
Excel columns run from A to Z, AA to AZ, AAA to XFD. The last column is XFD.
Sort by date Sort by votes
Can you please post all the code from one of the subs.
It's impossible to help with only one line of code.
 
Upvote 0
Fluff said:
Can you please post all the code from one of the subs.
It's impossible to help with only one line of code.
Click to expand...
VBA Code: 
Sub UpdateOldRecord(WyPtRow)
   
    Set DEFrm = Sheets("DataEntryForm")
    Set ObsData = Sheets("Observations")
     
    With ObsData
       
        .Cells(WyPtRow, 2).Value = DEFrm.Cells(6, 2).Value
        .Cells(WyPtRow, 3).Value = DEFrm.Cells(6, 4).Value
       
        .Cells(WyPtRow, 4).Value = DEFrm.Cells(8, 2).Value
        .Cells(WyPtRow, 5).Value = DEFrm.Cells(8, 4).Value
       
        .Cells(WyPtRow, 6).Value = DEFrm.Cells(6, 7).Value
        .Cells(WyPtRow, 7).Value = DEFrm.Cells(6, 8).Value
        .Cells(WyPtRow, 8).Value = DEFrm.Cells(7, 7).Value
        .Cells(WyPtRow, 9).Value = DEFrm.Cells(7, 8).Value
        .Cells(WyPtRow, 10).Value = DEFrm.Cells(8, 7).Value
        .Cells(WyPtRow, 11).Value = DEFrm.Cells(8, 8).Value
       
        .Cells(WyPtRow, 12).Value = DEFrm.Cells(11, 2).Value
        .Cells(WyPtRow, 13).Value = DEFrm.Cells(11, 3).Value
        .Cells(WyPtRow, 14).Value = DEFrm.Cells(11, 4).Value
        .Cells(WyPtRow, 15).Value = DEFrm.Cells(11, 5).Value
        .Cells(WyPtRow, 16).Value = DEFrm.Cells(11, 6).Value
        .Cells(WyPtRow, 17).Value = DEFrm.Cells(11, 7).Value
        .Cells(WyPtRow, 18).Value = DEFrm.Cells(11, 8).Value
        .Cells(WyPtRow, 19).Value = DEFrm.Cells(11, 9).Value
       
        .Cells(WyPtRow, 20).Value = DEFrm.Cells(14, 2).Value
        .Cells(WyPtRow, 21).Value = DEFrm.Cells(14, 3).Value
        .Cells(WyPtRow, 22).Value = DEFrm.Cells(14, 4).Value
        .Cells(WyPtRow, 23).Value = DEFrm.Cells(14, 5).Value
        .Cells(WyPtRow, 24).Value = DEFrm.Cells(14, 6).Value
        .Cells(WyPtRow, 25).Value = DEFrm.Cells(14, 7).Value
       
        .Cells(WyPtRow, 26).Value = DEFrm.Cells(17, 2).Value
        .Cells(WyPtRow, 27).Value = DEFrm.Cells(17, 3).Value
        .Cells(WyPtRow, 28).Value = DEFrm.Cells(17, 4).Value
        .Cells(WyPtRow, 29).Value = DEFrm.Cells(17, 5).Value
        .Cells(WyPtRow, 30).Value = DEFrm.Cells(17, 6).Value
        .Cells(WyPtRow, 31).Value = DEFrm.Cells(17, 7).Value
       
        .Cells(WyPtRow, 32).Value = DEFrm.Cells(14, 9).Value
        .Cells(WyPtRow, 33).Value = DEFrm.Cells(14, 10).Value
        .Cells(WyPtRow, 34).Value = DEFrm.Cells(15, 9).Value
        .Cells(WyPtRow, 35).Value = DEFrm.Cells(15, 10).Value
        .Cells(WyPtRow, 36).Value = DEFrm.Cells(16, 9).Value
        .Cells(WyPtRow, 37).Value = DEFrm.Cells(16, 10).Value
        .Cells(WyPtRow, 38).Value = DEFrm.Cells(17, 9).Value
        .Cells(WyPtRow, 39).Value = DEFrm.Cells(17, 10).Value
       
        .Cells(WyPtRow, 40).Value = DEFrm.Cells(20, 2).Value
        .Cells(WyPtRow, 41).Value = DEFrm.Cells(20, 3).Value
        .Cells(WyPtRow, 42).Value = DEFrm.Cells(20, 4).Value
        .Cells(WyPtRow, 43).Value = DEFrm.Cells(20, 5).Value
        .Cells(WyPtRow, 44).Value = DEFrm.Cells(20, 6).Value
        .Cells(WyPtRow, 45).Value = DEFrm.Cells(20, 7).Value
       
        .Cells(WyPtRow, 46).Value = DEFrm.Cells(23, 2).Value
        .Cells(WyPtRow, 47).Value = DEFrm.Cells(23, 3).Value
        .Cells(WyPtRow, 48).Value = DEFrm.Cells(23, 4).Value
        .Cells(WyPtRow, 49).Value = DEFrm.Cells(23, 5).Value
        .Cells(WyPtRow, 50).Value = DEFrm.Cells(23, 6).Value
       
        .Cells(WyPtRow, 51).Value = DEFrm.Cells(20, 9).Value
        .Cells(WyPtRow, 52).Value = DEFrm.Cells(20, 10).Value
        .Cells(WyPtRow, 53).Value = DEFrm.Cells(20, 11).Value
        .Cells(WyPtRow, 54).Value = DEFrm.Cells(21, 9).Value
        .Cells(WyPtRow, 55).Value = DEFrm.Cells(21, 10).Value
        .Cells(WyPtRow, 56).Value = DEFrm.Cells(21, 11).Value
        .Cells(WyPtRow, 57).Value = DEFrm.Cells(22, 9).Value
        .Cells(WyPtRow, 58).Value = DEFrm.Cells(22, 10).Value
        .Cells(WyPtRow, 59).Value = DEFrm.Cells(22, 11).Value
        .Cells(WyPtRow, 60).Value = DEFrm.Cells(23, 9).Value
        .Cells(WyPtRow, 61).Value = DEFrm.Cells(23, 10).Value
        .Cells(WyPtRow, 62).Value = DEFrm.Cells(23, 11).Value
       
        .Cells(WyPtRow, 63).Value = DEFrm.Cells(26, 2).Value
        .Cells(WyPtRow, 64).Value = DEFrm.Cells(26, 3).Value
        .Cells(WyPtRow, 65).Value = DEFrm.Cells(26, 4).Value
        .Cells(WyPtRow, 66).Value = DEFrm.Cells(26, 5).Value
        .Cells(WyPtRow, 67).Value = DEFrm.Cells(26, 6).Value
        .Cells(WyPtRow, 68).Value = DEFrm.Cells(26, 7).Value
        .Cells(WyPtRow, 69).Value = DEFrm.Cells(26, 8).Value
        .Cells(WyPtRow, 70).Value = DEFrm.Cells(26, 9).Value
        .Cells(WyPtRow, 71).Value = DEFrm.Cells(26, 10).Value
        .Cells(WyPtRow, 72).Value = DEFrm.Cells(26, 11).Value
        .Cells(WyPtRow, 73).Value = DEFrm.Cells(27, 2).Value
        .Cells(WyPtRow, 74).Value = DEFrm.Cells(27, 3).Value
        .Cells(WyPtRow, 75).Value = DEFrm.Cells(27, 4).Value
        .Cells(WyPtRow, 76).Value = DEFrm.Cells(27, 5).Value
        .Cells(WyPtRow, 77).Value = DEFrm.Cells(27, 6).Value
        .Cells(WyPtRow, 78).Value = DEFrm.Cells(27, 7).Value
        .Cells(WyPtRow, 79).Value = DEFrm.Cells(27, 8).Value
        .Cells(WyPtRow, 80).Value = DEFrm.Cells(27, 9).Value
        .Cells(WyPtRow, 81).Value = DEFrm.Cells(27, 10).Value
        .Cells(WyPtRow, 82).Value = DEFrm.Cells(27, 11).Value
        .Cells(WyPtRow, 83).Value = DEFrm.Cells(28, 2).Value
        .Cells(WyPtRow, 84).Value = DEFrm.Cells(28, 3).Value
        .Cells(WyPtRow, 85).Value = DEFrm.Cells(28, 4).Value
        .Cells(WyPtRow, 86).Value = DEFrm.Cells(28, 5).Value
        .Cells(WyPtRow, 87).Value = DEFrm.Cells(28, 6).Value
        .Cells(WyPtRow, 88).Value = DEFrm.Cells(28, 7).Value
        .Cells(WyPtRow, 89).Value = DEFrm.Cells(28, 8).Value
        .Cells(WyPtRow, 90).Value = DEFrm.Cells(28, 9).Value
        .Cells(WyPtRow, 91).Value = DEFrm.Cells(28, 10).Value
        .Cells(WyPtRow, 92).Value = DEFrm.Cells(28, 11).Value
        .Cells(WyPtRow, 93).Value = DEFrm.Cells(29, 2).Value
        .Cells(WyPtRow, 94).Value = DEFrm.Cells(29, 3).Value
        .Cells(WyPtRow, 95).Value = DEFrm.Cells(29, 4).Value
        .Cells(WyPtRow, 96).Value = DEFrm.Cells(29, 5).Value
        .Cells(WyPtRow, 97).Value = DEFrm.Cells(29, 6).Value
        .Cells(WyPtRow, 98).Value = DEFrm.Cells(29, 7).Value
        .Cells(WyPtRow, 99).Value = DEFrm.Cells(29, 8).Value
        .Cells(WyPtRow, 100).Value = DEFrm.Cells(29, 9).Value
        .Cells(WyPtRow, 101).Value = DEFrm.Cells(29, 10).Value
        .Cells(WyPtRow, 102).Value = DEFrm.Cells(29, 11).Value
       
        .Cells(WyPtRow, 103).Value = DEFrm.Cells(32, 2).Value
        .Cells(WyPtRow, 104).Value = DEFrm.Cells(32, 8).Value
        .Cells(WyPtRow, 105).Value = DEFrm.Cells(32, 9).Value
        .Cells(WyPtRow, 106).Value = DEFrm.Cells(32, 10).Value
        .Cells(WyPtRow, 107).Value = DEFrm.Cells(33, 8).Value
        .Cells(WyPtRow, 108).Value = DEFrm.Cells(33, 9).Value
        .Cells(WyPtRow, 109).Value = DEFrm.Cells(33, 10).Value
        .Cells(WyPtRow, 110).Value = DEFrm.Cells(34, 8).Value
        .Cells(WyPtRow, 111).Value = DEFrm.Cells(34, 9).Value
        .Cells(WyPtRow, 112).Value = DEFrm.Cells(34, 10).Value
        .Cells(WyPtRow, 113).Value = DEFrm.Cells(35, 8).Value
        .Cells(WyPtRow, 114).Value = DEFrm.Cells(35, 9).Value
        .Cells(WyPtRow, 115).Value = DEFrm.Cells(35, 10).Value
       
    End With        'With ObsData
   
   Call ClearForm
   
End Sub
 
Upvote 0
Thanks for that.
Where you have consecutive cells in a row, you can shorten it like
VBA Code: 
    With ObsData
       
        .Cells(WyPtRow, 2).Value = DEFrm.Cells(6, 2).Value
        .Cells(WyPtRow, 3).Value = DEFrm.Cells(6, 4).Value
       
        .Cells(WyPtRow, 4).Value = DEFrm.Cells(8, 2).Value
        .Cells(WyPtRow, 5).Value = DEFrm.Cells(8, 4).Value
       
        .Cells(WyPtRow, 6).Resize(, 2).Value = DEFrm.Cells(6, 7).Resize(, 2).Value
        .Cells(WyPtRow, 8).Resize(, 2).Value = DEFrm.Cells(7, 7).Resize(, 2).Value
        .Cells(WyPtRow, 10).Resize(, 2).Value = DEFrm.Cells(8, 7).Resize(, 2).Value
       
        .Cells(WyPtRow, 12).Resize(, 8).Value = DEFrm.Cells(11, 2).Resize(, 8).Value
       
        .Cells(WyPtRow, 20).Resize(, 6).Value = DEFrm.Cells(14, 2).Resize(, 6).Value
       
        .Cells(WyPtRow, 26).Resize(, 6).Value = DEFrm.Cells(17, 2).Resize(, 6).Value
       
        .Cells(WyPtRow, 32).Resize(, 2).Value = DEFrm.Cells(14, 9).Resize(, 2).Value
        .Cells(WyPtRow, 34).Value = DEFrm.Cells(15, 9).Value
 
Upvote 0
You must log in or register to reply here.

Similar threads

K
  • Solved
help with 'no cells found' error... (ideas on how to get around this...)
Replies
3
Views
178
Alex Blakenburg
A
S
  • Solved
Problem executing VBA code
2
Replies
12
Views
484
sofas
S
L
  • Question
Help with VBA code for a userform
Replies
1
Views
245
dmt32
D
H
  • Question
VBA Code for bulk Goal Seek
Replies
6
Views
201
hellokitty19
H
I
  • Question
VBA to remove formulas with values causing wrong calculations
2
Replies
12
Views
268
Peter_SSs
Peter_SSs

Forum statistics

Threads
1,214,827
Messages
6,121,806
Members
449,048
Latest member
greyangel23

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