VBA: Variable to reference cell value, run code, then reference cell below

[Seba Robles]

Hello everyone, so here's the information on my workbook and code;

- I have 2 worksheets; Sheet1 where I have a range of values in column A and Sheet2 where my code runs

Here's part of my code

Dim c As Integer

c = Worksheets("Sheet1").[B]Cells[/B][COLOR=#ff0000][B](16, "A")[/B][/COLOR][B].[/B]Value


Sheets("Sheet2").Select

Rows(c & ":" & c).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    
Rows("3:3").Select
Selection.Copy
Rows(c & ":" & c).Select
ActiveSheet.Paste

' Then select Next cell value from List/Range in Sheet1 to place in C variable

My code simply inserts a new row within Sheet2 in row c, copies formulas from row 3, pastes them in newly inserted row c.. and what I need next is for the c variable to select the next cell value from the list I have in Sheet 1, run code again until last cell value from Sheet1 List is completed.

Maybe a For Next or Loop code would help but I don't know how to implement it.

I would appreciate any help you can give, thanks in advance!

 

[Norie]

This will loop from row 16 down on Sheet1 until it reaches an empty cell.

Dim rng As Range
Dim c As Long

    Set rng = Sheets("Sheet1").Cells(16, "A")

    Do

        c = Worksheets("Sheet1").Cells(16, "A").Value

        With Sheets("Sheet2")

            .Rows(c & ":" & c).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

            .Rows("3:3").Copy .Rows(c & ":" & c)

        End With

        Set rng = rng.Offset(1)

    Loop Until rng.Value = ""

 

[Fluff]

Hi & welcome to MrExcel
Maybe

   Dim cl As Range
   For Each cl In Worksheets("Sheet1").Range("A16:A20")
      With Sheets("Sheet2")
         .Rows(cl.Value).Insert
         .Rows(3).Copy .Rows(cl.Value)
      End With
   Next cl

 

[Seba Robles]

Okay so the code is running as I want it to, but for some reason after the End With, the new range offset isn't kicking in, and when the loop begins again it runs the code on the previous set range again.

Any idea why this happens?

This will loop from row 16 down on Sheet1 until it reaches an empty cell.

Dim rng As Range
Dim c As Long

    Set rng = Sheets("Sheet1").Cells(16, "A")

    Do

        c = Worksheets("Sheet1").Cells(16, "A").Value

        With Sheets("Sheet2")

            .Rows(c & ":" & c).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

            .Rows("3:3").Copy .Rows(c & ":" & c)

        End With

        Set rng = rng.Offset(1)

    Loop Until rng.Value = ""

 

[Seba Robles]

Here's the complete code

Sub FillProjectionData()
Dim rng As Range
Dim c As Long
Dim c2 As Long
Dim c3 As Long
    
    Set rng = Sheets("Sheet1").Cells(2, "A")
    
    Do
    
        c = Worksheets("Sheet1").Cells(2, "A").Value
        c2 = Worksheets("Sheet1").Cells(2, "A").Value + 1
        c3 = Worksheets("Sheet1").Cells(2, "A").Value + 2
        
        With Sheets("Projection Data")
            .Rows(c & ":" & c).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            .Rows("3:3").Copy .Rows(c & ":" & c)
            Application.CutCopyMode = False
            .Rows(c2 & ":" & c2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            .Rows("4:4").Copy .Rows(c2 & ":" & c2)
            
            .Rows(c3 & ":" & c3).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            .Rows(c3 & ":" & c3).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            .Rows(c3 & ":" & c3).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            .Rows(c3 & ":" & c3).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            .Rows(c3 & ":" & c3).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            .Rows(c3 & ":" & c3).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            .Rows(c3 & ":" & c3).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            .Rows(c3 & ":" & c3).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            .Rows(c3 & ":" & c3).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            .Rows(c3 & ":" & c3).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            .Rows(c3 & ":" & c3).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            .Rows(c3 & ":" & c3).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            .Rows(c3 & ":" & c3).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            .Rows(c3 & ":" & c3).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    
            Range("A2").Select
            Selection.End(xlDown).Offset(14).Select
            Range(Selection, Selection.End(xlUp)).Select
            Range(Selection, Selection.End(xlToRight)).Select
            Selection.FillDown
     
        End With
        
    Set rng = rng.Offset(1)
Loop Until rng.Value = ""
End Sub

Please help me out

 

[Norie]

This part of your code has no worksheet references so will apply to whichever worksheet happens to be active.

            Range("A2").Select
            Selection.End(xlDown).Offset(14).Select
            Range(Selection, Selection.End(xlUp)).Select
            Range(Selection, Selection.End(xlToRight)).Select
            Selection.FillDown

Which worksheet should this code apply to?

 

[Fluff]

What are you trying t do with this part of your code?

            Range("A2").Select
            Selection.End(xlDown).Offset(14).Select
            Range(Selection, Selection.End(xlUp)).Select
            Range(Selection, Selection.End(xlToRight)).Select
            Selection.FillDown

 

[Seba Robles]

I'm not sure where my reply went.

So that part of the code just fills down the formulas from the last row above (with data) to the 14 inserted (blank) rows.

There's probably a cleaner way to write that but I'm still learning.

 

[Fluff]

Is this what you need?

Sub FillProjectionData()
   Dim c As Long
   Dim c2 As Long
   Dim c3 As Long
    
        c = Worksheets("Sheet1").Cells(2, "A").Value
        c2 = Worksheets("Sheet1").Cells(2, "A").Value + 1
        c3 = Worksheets("Sheet1").Cells(2, "A").Value + 2
        
        With Sheets("Projection Data")
            .Rows(c).Insert shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            .Rows("3:3").Copy .Rows(c)
            .Rows(c2).Insert shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            .Rows(4).Copy .Rows(c2)
            .Rows(c3).Resize(14).Insert shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            .Rows(c3).Offset(-1).Resize(15).FillDown
        End With
        
End Sub

 

[Seba Robles]

Oh nice that looks better, thanks.

And yes, but after running that, I need it to select the next value from the list in Sheet1

For example, I ran what you just posted once, and now

c = Worksheets("Sheet1").Cells([COLOR=#FF0000][B]3[/B][/COLOR], "A").Value

The Cells row value should move to the next cell from the list until the list ends or finds null value.