Need assistance modifying a "too large" procedure [closed]

Question

Closed. This question is off-topic. It is not currently accepting answers.

Code not implemented or not working as intended: Code Review is a community where programmers peer-review your working code to address issues such as security, maintainability, performance, and scalability. We require that the code be working correctly, to the best of the author's knowledge, before proceeding with a review.

Closed last year.

Improve this question

I have a chunky VBA script that needs some help making it efficient, which I think will correct the "Procedure too Large" issue I just ran into.

I run the procedure from an open workbook that I want to copy the data from. The data from the origin workbook will always be in the same cells. The cells in the destination workbook where the data is being copied will change, depending on whether a specific cell in the destination workbook has data in it.

It checks the destination workbook to see if a specific cell has data in it (A3). If that specific cell is blank, it copies many different cells (most are not adjacent) to different cells and different sheets in the destination workbook.

If there is data in that specific cell (A3), it will check if (A12) has data in it. If (A12) is blank, it will copy all the origin data to to different cells.

The data going to Sheet1 is offset is by 9 rows (this might change in the future, if this program grows). Currently it checks A3, A12, A21, etc. I have this maxed out at 10 if-then-else, but would like this to loop to 50.

Some of the data going to Sheet2 is offset by 3 rows starting at B14, but this will change to B54 if I can loop this 50 times.

Some of the other data going to Sheet2 will be copied to the row below the previous data starting at R3.

The data going to Sheet3 will also offset by 3 rows. 4 of the copied cells start at D13 and the rest start at K14.

Some of the code attached below

'
' Copy Sheets to Verifier file
'
    Dim wbCopy As Workbook
    Dim wbPasteV As Workbook
    Dim wsPasteMT As Worksheet
    Dim wsPasteSD As Worksheet
       
    Set wbCopy = Workbooks(ActiveWorkbook.Name)
    Set wbPasteV = Workbooks("Verifier.xlsm")
    Set wsPasteMT = wbPasteV.Sheets("Moved To")
    Set wsPasteSD = wbPasteV.Sheets("Sheet Data")
    Set wsPaste1111 = wbPasteV.Sheets("1111")
            
    With ActiveSheet
    .EnableSelection = xlNoRestrictions
    Application.ScreenUpdating = False
    
    wbPasteV.Activate
    wsPasteMT.Select
    
    If IsEmpty(Range("A3").Value) Then
    
    'This Copies the Data (Line 1)
    
    wbCopy.Activate
    Range("F17:H17").Select
    Application.CutCopyMode = False
    Selection.Copy
    wbPasteV.Activate
    wsPasteSD.Select
    Range("B14").Select
    Range("B14").PasteSpecial xlPasteValues

    wbCopy.Activate
    Range("J17").Select
    Application.CutCopyMode = False
    Selection.Copy
    wbPasteV.Activate
    wsPasteSD.Select
    Range("E14").Select
    Range("E14").PasteSpecial xlPasteValues
    
    wbCopy.Activate
    Range("N17:Q17").Select
    Application.CutCopyMode = False
    Selection.Copy
    wbPasteV.Activate
    wsPasteSD.Select
    Range("F14").Select
    Range("F14").PasteSpecial xlPasteValues
    
    wbCopy.Activate
    Range("F35:I35").Select
    Application.CutCopyMode = False
    Selection.Copy
    wbPasteV.Activate
    wsPasteSD.Select
    Range("J14").Select
    Range("J14").PasteSpecial xlPasteValues

    wbCopy.Activate
    Range("K35:L35").Select
    Application.CutCopyMode = False
    Selection.Copy
    wbPasteV.Activate
    wsPasteSD.Select
    Range("N14").Select
    Range("N14").PasteSpecial xlPasteValues

    wbCopy.Activate
    Range("M57").Select
    Application.CutCopyMode = False
    Selection.Copy
    wbPasteV.Activate
    wsPasteSD.Select
    Range("P14").Select
    Range("P14").PasteSpecial xlPasteValues
    
    wbCopy.Activate
    Range("F10:F13").Select
    Application.CutCopyMode = False
    Selection.Copy
    wbPasteV.Activate
    wsPasteSD.Select
    Range("R3").Select
    Range("R3").PasteSpecial xlPasteValues, Transpose:=True

    wbCopy.Activate
    Range("O10:O13").Select
    Application.CutCopyMode = False
    Selection.Copy
    wbPasteV.Activate
    wsPasteSD.Select
    Range("V3").Select
    Range("V3").PasteSpecial xlPasteValues, Transpose:=True
    
    wbCopy.Activate
    Range("F4:F5").Select
    Application.CutCopyMode = False
    Selection.Copy
    wbPasteV.Activate
    wsPasteSD.Select
    Range("Z3").Select
    Range("Z3").PasteSpecial xlPasteValues, Transpose:=True

    wbCopy.Activate
    Range("F6").Select
    Application.CutCopyMode = False
    Selection.Copy
    wbPasteV.Activate
    wsPasteSD.Select
    Range("AB3").Select
    Range("AB3").PasteSpecial xlPasteValues, Transpose:=True

    wbCopy.Activate
    Range("F7").Select
    Application.CutCopyMode = False
    Selection.Copy
    wbPasteV.Activate
    wsPasteSD.Select
    Range("AC3").Select
    Range("AC3").PasteSpecial xlPasteValues, Transpose:=True
    
    wbCopy.Activate
    Range("Q4").Select
    Application.CutCopyMode = False
    Selection.Copy
    wbPasteV.Activate
    wsPasteSD.Select
    Range("AD3").Select
    Range("AD3").PasteSpecial xlPasteValues
    
    wbCopy.Activate
    Range("P6").Select
    Application.CutCopyMode = False
    Selection.Copy
    wbPasteV.Activate
    wsPasteSD.Select
    Range("AE3").Select
    Range("AE3").PasteSpecial xlPasteValues
    
    wbCopy.Activate
    Range("P7").Select
    Application.CutCopyMode = False
    Selection.Copy
    wbPasteV.Activate
    wsPasteSD.Select
    Range("AF3").Select
    Range("AF3").PasteSpecial xlPasteValues
    
    'This Copies the 1111 Data (Line 1)
    
    wbCopy.Activate
    Range("F100").Select
    Application.CutCopyMode = False
    Selection.Copy
    wbPasteV.Activate
    wsPaste4012.Select
    Range("D13").Select
    Range("D13").PasteSpecial xlPasteValues

    wbCopy.Activate
    Range("H100").Select
    Application.CutCopyMode = False
    Selection.Copy
    wbPasteV.Activate
    wsPaste4012.Select
    Range("E13").Select
    Range("E13").PasteSpecial xlPasteValues
    
    wbCopy.Activate
    Range("F102").Select
    Application.CutCopyMode = False
    Selection.Copy
    wbPasteV.Activate
    wsPaste4012.Select
    Range("G13").Select
    Range("G13").PasteSpecial xlPasteValues

    wbCopy.Activate
    Range("H102").Select
    Application.CutCopyMode = False
    Selection.Copy
    wbPasteV.Activate
    wsPaste4012.Select
    Range("H13").Select
    Range("H13").PasteSpecial xlPasteValues
    
    wbCopy.Activate
    Range("L101:M101").Select
    Application.CutCopyMode = False
    Selection.Copy
    wbPasteV.Activate
    wsPaste4012.Select
    Range("K14").Select
    Range("K14").PasteSpecial xlPasteValues

    wbCopy.Activate
    Range("H17").Select
    Application.CutCopyMode = False
    Selection.Copy
    wbPasteV.Activate
    wsPaste4012.Select
    Range("M14").Select
    Range("M14").PasteSpecial xlPasteValues
    
    wbCopy.Activate
    Range("F90").Select
    Application.CutCopyMode = False
    Selection.Copy
    wbPasteV.Activate
    wsPaste4012.Select
    Range("N14").Select
    Range("N14").PasteSpecial xlPasteValues
       
    wbCopy.Activate
    Range("R35").Select
    Application.CutCopyMode = False
    Selection.Copy
    wbPasteV.Activate
    wsPaste4012.Select
    Range("O14").Select
    Range("O14").PasteSpecial xlPasteValues
    
    wbCopy.Activate
    Range("R48").Select
    Application.CutCopyMode = False
    Selection.Copy
    wbPasteV.Activate
    wsPaste4012.Select
    Range("P14").Select
    Range("P14").PasteSpecial xlPasteValues

    wbCopy.Activate
    Range("L92").Select
    Application.CutCopyMode = False
    Selection.Copy
    wbPasteV.Activate
    wsPaste4012.Select
    Range("R14").Select
    Range("R14").PasteSpecial xlPasteValues
    
    wbCopy.Activate
    Range("O11").Select
    Application.CutCopyMode = False
    Selection.Copy
    wbPasteV.Activate
    wsPaste4012.Select
    Range("S14").Select
    Range("S14").PasteSpecial xlPasteValues
    
    'This Copies the Remove Data (Line 1)
    
    wbCopy.Activate
    Range("Q5").Select
    Application.CutCopyMode = False
    Selection.Copy
    wbPasteV.Activate
    wsPasteMT.Select
    Range("A3").Select
    Range("A3").PasteSpecial xlPasteValues
        
    wbCopy.Activate
    Range("I18").Select
    Application.CutCopyMode = False
    Selection.Copy
    wbPasteV.Activate
    wsPasteMT.Select
    Range("C3").Select
    Range("C3").PasteSpecial xlPasteValues

    wbCopy.Activate
    Range("K18:M18").Select
    Application.CutCopyMode = False
    Selection.Copy
    wbPasteV.Activate
    wsPasteMT.Select
    Range("D3").Select
    Range("D3").PasteSpecial xlPasteValues
    
    wbCopy.Activate
    Range("M36:Q36").Select
    Application.CutCopyMode = False
    Selection.Copy
    wbPasteV.Activate
    wsPasteMT.Select
    Range("G3").Select
    Range("G3").PasteSpecial xlPasteValues
    
    wbCopy.Activate
    Range("F58:I58").Select
    Application.CutCopyMode = False
    Selection.Copy
    wbPasteV.Activate
    wsPasteMT.Select
    Range("L3").Select
    Range("L3").PasteSpecial xlPasteValues

    wbCopy.Activate
    Range("K58:L58").Select
    Application.CutCopyMode = False
    Selection.Copy
    wbPasteV.Activate
    wsPasteMT.Select
    Range("P3").Select
    Range("P3").PasteSpecial xlPasteValues

    wbCopy.Activate
    Range("N58:O58").Select
    Application.CutCopyMode = False
    Selection.Copy
    wbPasteV.Activate
    wsPasteMT.Select
    Range("R3").Select
    Range("R3").PasteSpecial xlPasteValues

ElseIf IsEmpty(Range("A12").Value) Then

    'This Copies the Data (Line 2)

    wbCopy.Activate
    Range("F17:H17").Select
    Application.CutCopyMode = False
    Selection.Copy
    wbPasteV.Activate
    wsPasteSD.Select
    Range("B17").Select
    Range("B17").PasteSpecial xlPasteValues

    wbCopy.Activate
    Range("J17").Select
    Application.CutCopyMode = False
    Selection.Copy
    wbPasteV.Activate
    wsPasteSD.Select
    Range("E17").Select
    Range("E17").PasteSpecial xlPasteValues
    
    wbCopy.Activate
    Range("N17:Q17").Select
    Application.CutCopyMode = False
    Selection.Copy
    wbPasteV.Activate
    wsPasteSD.Select
    Range("F17").Select
    Range("F17").PasteSpecial xlPasteValues
    
    wbCopy.Activate
    Range("F35:I35").Select
    Application.CutCopyMode = False
    Selection.Copy
    wbPasteV.Activate
    wsPasteSD.Select
    Range("J17").Select
    Range("J17").PasteSpecial xlPasteValues

    wbCopy.Activate
    Range("K35:L35").Select
    Application.CutCopyMode = False
    Selection.Copy
    wbPasteV.Activate
    wsPasteSD.Select
    Range("N17").Select
    Range("N17").PasteSpecial xlPasteValues

    wbCopy.Activate
    Range("M57").Select
    Application.CutCopyMode = False
    Selection.Copy
    wbPasteV.Activate
    wsPasteSD.Select
    Range("P17").Select
    Range("P17").PasteSpecial xlPasteValues

    wbCopy.Activate
    Range("F10:F13").Select
    Application.CutCopyMode = False
    Selection.Copy
    wbPasteV.Activate
    wsPasteSD.Select
    Range("R4").Select
    Range("R4").PasteSpecial xlPasteValues, Transpose:=True

    wbCopy.Activate
    Range("O10:O13").Select
    Application.CutCopyMode = False
    Selection.Copy
    wbPasteV.Activate
    wsPasteSD.Select
    Range("V4").Select
    Range("V4").PasteSpecial xlPasteValues, Transpose:=True
    
    wbCopy.Activate
    Range("F4:F5").Select
    Application.CutCopyMode = False
    Selection.Copy
    wbPasteV.Activate
    wsPasteSD.Select
    Range("Z4").Select
    Range("Z4").PasteSpecial xlPasteValues, Transpose:=True

    wbCopy.Activate
    Range("F6").Select
    Application.CutCopyMode = False
    Selection.Copy
    wbPasteV.Activate
    wsPasteSD.Select
    Range("AB4").Select
    Range("AB4").PasteSpecial xlPasteValues, Transpose:=True

    wbCopy.Activate
    Range("F7").Select
    Application.CutCopyMode = False
    Selection.Copy
    wbPasteV.Activate
    wsPasteSD.Select
    Range("AC4").Select
    Range("AC4").PasteSpecial xlPasteValues, Transpose:=True
    
    wbCopy.Activate
    Range("Q4").Select
    Application.CutCopyMode = False
    Selection.Copy
    wbPasteV.Activate
    wsPasteSD.Select
    Range("AD4").Select
    Range("AD4").PasteSpecial xlPasteValues
    
    wbCopy.Activate
    Range("P6").Select
    Application.CutCopyMode = False
    Selection.Copy
    wbPasteV.Activate
    wsPasteSD.Select
    Range("AE4").Select
    Range("AE4").PasteSpecial xlPasteValues
    
    wbCopy.Activate
    Range("P7").Select
    Application.CutCopyMode = False
    Selection.Copy
    wbPasteV.Activate
    wsPasteSD.Select
    Range("AF4").Select
    Range("AF4").PasteSpecial xlPasteValues

    'This Copies the 1111 Data (Line 2)
           
    wbCopy.Activate
    Range("F100").Select
    Application.CutCopyMode = False
    Selection.Copy
    wbPasteV.Activate
    wsPaste4012.Select
    Range("D16").Select
    Range("D16").PasteSpecial xlPasteValues

    wbCopy.Activate
    Range("H100").Select
    Application.CutCopyMode = False
    Selection.Copy
    wbPasteV.Activate
    wsPaste4012.Select
    Range("E16").Select
    Range("E16").PasteSpecial xlPasteValues
    
    wbCopy.Activate
    Range("F102").Select
    Application.CutCopyMode = False
    Selection.Copy
    wbPasteV.Activate
    wsPaste4012.Select
    Range("G16").Select
    Range("G16").PasteSpecial xlPasteValues

    wbCopy.Activate
    Range("H102").Select
    Application.CutCopyMode = False
    Selection.Copy
    wbPasteV.Activate
    wsPaste4012.Select
    Range("H16").Select
    Range("H16").PasteSpecial xlPasteValues
    
    wbCopy.Activate
    Range("L101:M101").Select
    Application.CutCopyMode = False
    Selection.Copy
    wbPasteV.Activate
    wsPaste4012.Select
    Range("K17").Select
    Range("K17").PasteSpecial xlPasteValues

    wbCopy.Activate
    Range("H17").Select
    Application.CutCopyMode = False
    Selection.Copy
    wbPasteV.Activate
    wsPaste4012.Select
    Range("M17").Select
    Range("M17").PasteSpecial xlPasteValues
    
    wbCopy.Activate
    Range("F90").Select
    Application.CutCopyMode = False
    Selection.Copy
    wbPasteV.Activate
    wsPaste4012.Select
    Range("N17").Select
    Range("N17").PasteSpecial xlPasteValues
       
    wbCopy.Activate
    Range("R35").Select
    Application.CutCopyMode = False
    Selection.Copy
    wbPasteV.Activate
    wsPaste4012.Select
    Range("O17").Select
    Range("O17").PasteSpecial xlPasteValues
    
    wbCopy.Activate
    Range("R48").Select
    Application.CutCopyMode = False
    Selection.Copy
    wbPasteV.Activate
    wsPaste4012.Select
    Range("P17").Select
    Range("P17").PasteSpecial xlPasteValues

    wbCopy.Activate
    Range("L92").Select
    Application.CutCopyMode = False
    Selection.Copy
    wbPasteV.Activate
    wsPaste4012.Select
    Range("R17").Select
    Range("R17").PasteSpecial xlPasteValues
    
    wbCopy.Activate
    Range("O11").Select
    Application.CutCopyMode = False
    Selection.Copy
    wbPasteV.Activate
    wsPaste4012.Select
    Range("S17").Select
    Range("S17").PasteSpecial xlPasteValues

    'This Copies the Remove Data (Line 2)
    
    wbCopy.Activate
    Range("Q5").Select
    Application.CutCopyMode = False
    Selection.Copy
    wbPasteV.Activate
    wsPasteMT.Select
    Range("A12").Select
    Range("A12").PasteSpecial xlPasteValues
        
    wbCopy.Activate
    Range("I18").Select
    Application.CutCopyMode = False
    Selection.Copy
    wbPasteV.Activate
    wsPasteMT.Select
    Range("C12").Select
    Range("C12").PasteSpecial xlPasteValues

    wbCopy.Activate
    Range("K18:M18").Select
    Application.CutCopyMode = False
    Selection.Copy
    wbPasteV.Activate
    wsPasteMT.Select
    Range("D12").Select
    Range("D12").PasteSpecial xlPasteValues
    
    wbCopy.Activate
    Range("M36:Q36").Select
    Application.CutCopyMode = False
    Selection.Copy
    wbPasteV.Activate
    wsPasteMT.Select
    Range("G12").Select
    Range("G12").PasteSpecial xlPasteValues
    
    wbCopy.Activate
    Range("F58:I58").Select
    Application.CutCopyMode = False
    Selection.Copy
    wbPasteV.Activate
    wsPasteMT.Select
    Range("L12").Select
    Range("L12").PasteSpecial xlPasteValues

    wbCopy.Activate
    Range("K58:L58").Select
    Application.CutCopyMode = False
    Selection.Copy
    wbPasteV.Activate
    wsPasteMT.Select
    Range("P12").Select
    Range("P12").PasteSpecial xlPasteValues

    wbCopy.Activate
    Range("N58:O58").Select
    Application.CutCopyMode = False
    Selection.Copy
    wbPasteV.Activate
    wsPasteMT.Select
    Range("R12").Select
    Range("R12").PasteSpecial xlPasteValues

ElseIf IsEmpty(Range("A21").Value) Then
    
    'This Copies the Data (Line 3)

' The Procedure ends with this
Else

MsgBox ("Maximum Rows Reached")

End If
End With
End Sub

The current question title, which states your concerns about the code, applies to too many questions on this site to be useful. The site standard is for the title to simply state the task accomplished by the code. Please see How to Ask for examples, and revise the title accordingly. — Mast
– Mast ♦, Commented May 22, 2024 at 18:49

J_H · Accepted Answer · 2024-05-22 18:47:07Z

This may not be the appropriate site for this question -- the coding path you've been going down thus far calls into question whether advice or documentation would change your practice.

I will tackle just the restricted item of "code not working as intended". Your software vendor imposes a pretty amazing 16-bit restriction on your 64-bit machine. Here is one way to work around that restriction, if we assume that parameterization or "learning about loops" are off the table.

define subprocedures

A common theme in software engineering is that, when Author feels the need to write comments in the middle of a procedure, likely that procedure is Too Long. Typically we hit the limits of human cognition before we hit machine limits, but I guess many things are possible.

    'This Copies the Data (Line 1)

This source line suggests defining a new subprocedure:

Sub copy_data_line_1()
    ...
End Sub

Invoke with Call copy_data_line_1().

Similarly the code following this

    'This Copies the Remove Data (Line 1)

might be banished beneath

Sub copy_the_remove_data_line_1()
    ...
End Sub

There are additional sections which might come in for similar treatment.

Has all this improved the quality or maintainability of your code? No. It's also not improving the ability of your project to attract and retain technically skilled colaborators.

It does give you a larger number of 64-KiB buckets in which you can store copy-n-pasted chunks of code. So, not a "solution", more of a work around. I'm trying to meet you where you are.

I encourage you to scour the web and your local bookstore for VBA programming resources which would help you to cobble together a real solution to the business need. Perhaps the present codebase is an asset, but it's a fragile one.

"This may not be the appropriate site for this question -- the coding path you've been going down thus far calls into question whether advice or documentation would change your practice." It's their first question on the site, what makes you say this? — Mast
– Mast ♦, Commented May 22, 2024 at 18:50
The audience for SE Code Review is potentially fairly broad: folks who have tried to pay careful attention to the details when producing an implementation, and seek outside advice to refine their approach. Typically we see some evident pride in workmanship, together with "I think I can do better and I wish to learn." I found little evidence of that in the OP, so I tried to address it more as an SO question ("my code doesn't work; please help me to make it work") rather than as Code Review question. That said, getting bounced from site to site is frustrating, and I wanted to offer something. — J_H
– J_H, Commented May 22, 2024 at 18:55

Stack Exchange Network

Need assistance modifying a "too large" procedure [closed]

1 Answer 1

define subprocedures

Hot Network Questions

Need assistance modifying a "too large" procedure [closed]

1 Answer 1

define subprocedures

Related

Hot Network Questions