Please help clean up my convoluted VBA code. It seems very redundant and repetitive.

C

CapRavOr

New Member
Joined
Apr 26, 2022
Messages
5
Office Version
  1. 365
  2. 2021
  3. 2019
Platform
  1. Windows
This is some (poor) vba code I wrote in order to take multirow information and unpivot it for a table that will be used elsewhere. I know unpivoting can be done in power pivot or even just in excel, but in my situation, having a macro run this code would be a whole hell of a lot easier. Thank you for any help!

VBA Code: 
Sub macTargetStageMacro()
'
' Takes the values, B5:M11, and transposes them onto the Target Staging table
' Then, takes X5:Y88, copies, and pastes to P5
' Then, takes the Market in B2, copies, and pastes to the entire Market column in the stage table

' First, establishes the proper worksheet, Target Staging

    Sheets("Target Staging").Select
    
' Next, takes the information held in the data table and paste/transposes it to S+12

    Range("B5:M5").Select
    Selection.Copy
    Range("tblTargetStaging[Value]").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    
' Selects the Program/Modality from column A, copies, and pastes it in the "Program Modality" column, next to the data that was just pasted
    
    Range("A5").Select
    Selection.Copy
    Range("R5:R16").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Range("B6:M6").Select
    Selection.Copy
    Range("S17").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Range("A6").Select
    Selection.Copy
    Range("R17:R28").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Range("B7:M7").Select
    Selection.Copy
    Range("S29").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Range("A7").Select
    Selection.Copy
    Range("R29:R40").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Range("B8:M8").Select
    Selection.Copy
    Range("S41").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Range("A8").Select
    Selection.Copy
    Range("R41:R52").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Range("B9:M9").Select
    Selection.Copy
    Range("S53").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Range("A9").Select
    Selection.Copy
    Range("R53:R64").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Range("B10:M10").Select
    Selection.Copy
    Range("S65").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Range("A10").Select
    Selection.Copy
    Range("R65:R76").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Range("B11:M11").Select
    Selection.Copy
    Range("S77").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Range("A11").Select
    Selection.Copy
    Range("R77:R88").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

' Next, takes the Periods and Dates to the right of the table, copies, and pastes them into the Target Stage table
    
    Range("X5").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Range("P5").Select
    ActiveSheet.Paste
    
' Finally, takes the Market from B2 and pastes it entirely through column O
    
    Range("B2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("O5").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    Application.CutCopyMode = False
    
' I might need to test this out
    
'    ContinueToAppendToTargetTable = MsgBox("Continue Appending the Target Table?", 1, "Continue to Append")
'        If ContinueToAppendToTargetTable = vbOK Then

' Append to the Target table
    
    Sheets("Target Staging").Select
    Range("tblTargetStaging").Copy
    Sheets("Target (Budget) Data").Select
    Range("A1").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste
    Sheets("Target Staging").Select
    Application.CutCopyMode = False
    
'        ElseIf ContinueToAppendToTargetTable = vbCancel Then
'    End If

'Clear the staging table

    Range("O5").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
    ActiveSheet.ListObjects("tblTargetStaging").Resize Range("$O$4:$S$5")
    Range("B5:M11").Select
    Selection.ClearContents
    Range("A1").Select
    Application.CutCopyMode = False
    
End Sub
 

Excel Facts

Which came first: VisiCalc or Lotus 1-2-3?
Dan Bricklin and Bob Frankston debuted VisiCalc in 1979 as a Visible Calculator. Lotus 1-2-3 debuted in the early 1980's, from Mitch Kapor.
Sort by date Sort by votes
As an almost universal rule, it it not necessary to 'select' anything prior to operating on it.

Thus for example your first few lines can be reduced to:

VBA Code: 
' Take information in Target Staging data table and transpose to S+12

    Sheets("Target Staging").Range("B5:M5").Copy
    Range("tblTargetStaging[Value]").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Solved
Please help me clean up my VBA script, I'm having trouble with redundancies
Replies
4
Views
156
CapRavOr
C
P
  • Solved
Counter in For Each loop
Replies
2
Views
263
Possum17
P
J
  • Question
VBA to select partial filename and go back and forth between two files to copy paste
Replies
1
Views
231
shknbk2
S
P
  • Solved
Need help with macro Dynamic Range??
Replies
6
Views
263
pennbowl
P
A
  • Question
Macro to update list to last row on another sheet copy source from multiple sheets
Replies
0
Views
347
Azamamir
A

Forum statistics

Threads
1,216,500
Messages
6,131,015
Members
449,615
Latest member
Nic0la

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