Increase range by 2

[rex759]

Hello,

I want to add this formula starting at B1 and paste it down 23 rows. However, I want DD1!B3 to increase to DD1!B5 for the second row, DD1!B7 to the Third and so on.

Worksheets("Sheet1").Range("B1") = "=IFERROR(MID('DD1'!B3,FIND(""000"","" ""&'DD1'!B3)-1,FIND("" "",'DD1'!B3,FIND(""000"","" ""&'DD1'!B3)-1)-FIND(""000"","" "" &'DD1'!B3)+13),IFERROR(MID('DD1'!B3,FIND(""100"","" ""&'DD1'!B3)-1,FIND("" "",'DD1'!B3,FIND(""100"","" ""&'DD1'!B3)-1)-FIND(""100"","" "" &'DD1'!B3)+13),""""))"

Range("B1").Copy

Range("B2:B23).PasteSpecial Paste:=xlFormulas, operation:=xlNone, skipblanks _

:=False, Transpose:=False

Any directions or help is appreciated.

 

[rlv01]

One way.

    Dim R As Range, FStr As String, I As Long, N As Long
    
    Set R = Worksheets("Sheet1").Range("B1")
    FStr = "=IFERROR(MID('DD1'!B3,FIND(""000"","" ""&'DD1'!B3)-1,FIND("" "",'DD1'!B3,FIND(""000"","" ""&'DD1'!B3)-1)-FIND(""000"","" "" &'DD1'!B3)+13),IFERROR(MID('DD1'!B3,FIND(""100"","" ""&'DD1'!B3)-1,FIND("" "",'DD1'!B3,FIND(""100"","" ""&'DD1'!B3)-1)-FIND(""100"","" "" &'DD1'!B3)+13),""""))"
    R.Formula = FStr
    
    N = 5
    For I = 1 To 22
        With R.Offset(I)
            .Formula = Replace(FStr, "B3", "B" & N)
            N = N + 2
        End With
    Next I

 

[rex759]

One way.

    Dim R As Range, FStr As String, I As Long, N As Long
   
    Set R = Worksheets("Sheet1").Range("B1")
    FStr = "=IFERROR(MID('DD1'!B3,FIND(""000"","" ""&'DD1'!B3)-1,FIND("" "",'DD1'!B3,FIND(""000"","" ""&'DD1'!B3)-1)-FIND(""000"","" "" &'DD1'!B3)+13),IFERROR(MID('DD1'!B3,FIND(""100"","" ""&'DD1'!B3)-1,FIND("" "",'DD1'!B3,FIND(""100"","" ""&'DD1'!B3)-1)-FIND(""100"","" "" &'DD1'!B3)+13),""""))"
    R.Formula = FStr
   
    N = 5
    For I = 1 To 22
        With R.Offset(I)
            .Formula = Replace(FStr, "B3", "B" & N)
            N = N + 2
        End With
    Next I

It works perfectly! Thank you so much.

 

[rex759]

If I wanted to add another formula starting in F1 following the same logic, can I nest it with the For next loop or do I need to create another loop?

Set R = Worksheets("Sheet1").Range("B1")
Set S = Worksheets("Sheet1").Range("F1")

FSts ="=TRIM(MID('DD1'!B3,FIND(""#"",SUBSTITUTE('DD1'!B3,"" "",""#"",LEN('DD1'!B3)-LEN(SUBSTITUTE('DD1'!B3,"" "",""""))-3)),FIND("" "",'DD1'!B3,FIND(""#"",SUBSTITUTE('DD1'!B3,"" "",""#"",LEN('DD1'!B3)-LEN(SUBSTITUTE('DD1'!B3,"" "",""""))-3))+1)-FIND(""#"",SUBSTITUTE('DD1'!B3,"" "",""#"",LEN('DD1'!B3)-LEN(SUBSTITUTE('DD1'!B3,"" "",""""))-3))))"

R.Formula = FStr

S.Formula = FSts

N = 5

For I = 1 To 22

With R.Offset(I)

.Formula = Replace(FStr, "B3", "B" & N)

.Formula = Replace(FSts, "B3", "B" & N)

N = N + 2

End With

Next I

 

[rex759]

Maybe something like this?

With R.Offset(I)

.Formula = Replace(FStr, "B3", "B" & N)

.Offset(0, 4).Formula = Replace(FSts, "B3", "B" & N)

N = N + 2

End With

 

[rlv01]

Assuming you want the same formula using column B in both places, the above might work, but you would have to test it to be sure. Personally I think it would be cleaner to just add a 2nd loop. The extra CPU time is negligible.

Dim R As Range, FStr As String, I As Long, N As Long
   
    'Col B
    Set R = Worksheets("Sheet1").Range("B1")
    FStr = "=IFERROR(MID('DD1'!B3,FIND(""000"","" ""&'DD1'!B3)-1,FIND("" "",'DD1'!B3,FIND(""000"","" ""&'DD1'!B3)-1)-FIND(""000"","" "" &'DD1'!B3)+13),IFERROR(MID('DD1'!B3,FIND(""100"","" ""&'DD1'!B3)-1,FIND("" "",'DD1'!B3,FIND(""100"","" ""&'DD1'!B3)-1)-FIND(""100"","" "" &'DD1'!B3)+13),""""))"
    R.Formula = FStr
   
    N = 5
    For I = 1 To 22
        With R.Offset(I)
            .Formula = Replace(FStr, "B3", "B" & N)
            N = N + 2
        End With
    Next I
   
    'Col F
    Set R = Worksheets("Sheet1").Range("F1")
    R.Formula = FStr
   
    N = 5
    For I = 1 To 22
        With R.Offset(I)
            .Formula = Replace(FStr, "B3", "B" & N)
            N = N + 2
        End With
    Next I

 

[rex759]

I did a quick test using my version and it worked but I like your version better as it easier to debug.

Thanks again