Run macro in selected cells

Question

I need to create a simple macro to clean my worksheets. Basically, if there are multiple orders on 1 shipment, I need those orders to be displayed vertically instead of horizontally example:

excel example

I created a macro that will copy/paste the 1st row into the row below it and then change the 2nd order with another copy/paste.

Pretty simple. My problem is the macro is binded to the ranges I created the macro in.

How can I make it so I can run this macro on selected ranges. Rather than manually copy and pasting every row with multiple orders, I'd rather highlight the rows with multiple orders and run the macro.

This is the code:

ActiveCell.Range("A1:M1").Select
Selection.Copy
ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
Selection.Insert Shift:=xlDown
ActiveCell.Offset(0, 3).Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
ActiveCell.Offset(0, -1).Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(-1, 1).Range("A1:A2").Select
Application.CutCopyMode = False
Selection.ClearContents

vba code

Please do not post pictures of code. Instead copy/paste the code into the question so that others can copy/paste it if they want/need to. — braX, May 11 '22 at 20:40
I tried to copy and paste the code into the question and it gave me an error — iTerrify, May 11 '22 at 20:42
In general, you want to [avoid using select](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba) in your code — cybernetic.nomad, May 11 '22 at 22:00
Have you tried running this macro with different selections? The way it is written (using offsets and `ActiveCell.Range`) it seems like it would already work if you selected a different cell. — user1274820, May 11 '22 at 22:35

karma · Answer 1 · 2022-05-12T15:42:18.450

If I understand you correctly, maybe something like this ?

need those orders to be displayed vertically instead of horizontally

Sub test1()
Dim rg As Range
Dim cc As Range

Set rg = Range("C2")

Do
    If rg.Offset(0, 1).Value <> "" Then
        Set cc = Range(rg, rg.End(xlToRight))
        Rows(rg.Row).Copy
        Rows(rg.Row + 1 & ":" & rg.Row + cc.Columns.Count - 1).Insert Shift:=xlDown
        rg.Resize(cc.Columns.Count, 1).Value = Application.Transpose(cc)
        rg.Offset(0, 1).Resize(cc.Columns.Count, cc.Columns.Count - 1).ClearContents
        Set rg = rg.Offset(cc.Columns.Count, 0)
    Else
        Set rg = rg.Offset(1, 0)
    End If
Loop Until rg.Value = ""

End Sub

How can I make it so I can run this macro on selected ranges

Sub test2()
Dim rg As Range
Set rg = Application.InputBox("Select a certain row starts from column C", Type:=8)
Rows(rg.Row).Copy
Rows(rg.Row + 1 & ":" & rg.Row + rg.Columns.Count - 1).Insert Shift:=xlDown
rg.Resize(rg.Columns.Count, 1).Value = Application.Transpose(rg)
rg.Offset(0, 1).Resize(rg.Columns.Count, rg.Columns.Count - 1).ClearContents
End Sub

For sub test1
The code assumed that the delivery number will start in cell C2 which defined as variable rg then do a loop

If the the cell to the right of the rg is not empty,
then it define a range from the rg to the last column of the rg row which has value as cc variable.
Then it copy insert as many as the columns are there inside cc.
Then it transpose the cc value from column to row.
Then it delete the uneeded value.

If the the cell to the right of the rg is empty,
then it doesn't do a process, it just reset the rg to the cell below.

For sub test2
It ask a user to select a range, starts from column C to whatever last column (with value) within the same row. Then do the similar process like in test1.

This worked beautifully! thank-You! – iTerrify May 16 '22 at 20:04 — iTerrify, May 16 '22 at 20:04

Run macro in selected cells

1 Answers1