0

I'm trying to change my designated column "J" to a variable (the next free column on row 5) as sometimes J is in use. Then apply the formula to that column and copy it, inserting after Column A. I know that I need to set the value for the last column, but I'm not sure how to bring it all together for my formula. The formula generally works well until data is introduced to Column J or K, then it pastes over it.

Range("J5").Select
ActiveCell.FormulaR1C1 = "=RIGHT(RC[-2], 6)"
Selection.AutoFill Destination:=Range("J5:J" & Range("E" & Rows.Count).End(xlUp).Row)
Range(Selection, Selection.End(xlDown)).Select


Columns("B:B").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

Range("A5").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.TextToColumns Destination:=Range("A5"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 3), Array(2, 3), Array(3, 3)), TrailingMinusNumbers:=True

Range("B5").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.NumberFormat = "dd/mm/yyyy;@"
Selection.TextToColumns Destination:=Range("B5"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
:=Array(1, 8), TrailingMinusNumbers:=True

Columns("B:B").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

Range("M5").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

Range("B5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd, SkipBlanks _
:=False, Transpose:=False

End Sub

Miles Fett
  • 711
  • 4
  • 17
Paul
  • 5
  • 2
  • 1
    like with the row, `.range("E5").End(xlToRight).column` you can use this to `offset` for example – Nathan_Sav Oct 17 '19 at 17:48
  • 2
    Possible duplicate of [Excel VBA- Finding the last column with data](https://stackoverflow.com/questions/11926972/excel-vba-finding-the-last-column-with-data) – BigBen Oct 17 '19 at 17:53
  • If you always need the value from `Column H` you need to change your formula from `"=RIGHT(RC[-2], 6)"` to `"=RIGHT(R5C8, 6)"` See my answer as an example. – GMalc Oct 17 '19 at 19:21

1 Answers1

0

You can accomplish this by starting at Range("I5") and using Resize and Offset to insert the formula into the range without using AutoFill.

The code below is a one-liner. Note: you subtract the 4 and 8 to account for the rows and columns from the strtCel

ActiveSheet. _
Range("I5").Resize(ActiveSheet.Range("E" & Rows.Count).End(xlUp).Row - 4, 1). _
Offset(, ActiveSheet.Cells(5, Columns.Count).End(xlToLeft).Column - 8). _
FormulaR1C1 = "=RIGHT(RC8, 6)"

You can also use variables

Dim ws As Worksheet, lRow As Long, eCol As Long, strtCel As Range

Set ws = ThisWorkbook.Sheets("Sheet1") 'Change worksheet name as needed
Set strtCel = ws.Range("I5")

lRow = ws.Range("E" & ws.Rows.Count).End(xlUp).Row
eCol = ws.Cells(5, ws.Columns.Count).End(xlToLeft).Column

    With strtCel.Resize(lRow - 4, 1).Offset(, eCol - 8)
        .FormulaR1C1 = "=RIGHT(RC8, 6)"
        .Value = .Value
    End With  
GMalc
  • 2,608
  • 1
  • 9
  • 16
  • Hey GMalc.. Your one liner does indeed find the next free column and apply my formula, but only to the first cell. It then copies the same value down that column instead of applying the formula all the way down. Any idea on how to adjust this? – Paul Oct 23 '19 at 16:25
  • Hey @Paul Remove the `5` from `R5C8`, added due to typo. The problem was because the `5` did not have `[ ]` to remove the absolute reference ($), all the formulas took the value from the same cell. A problem will arise if you change the data in `Col H` the formula will cause the change to be applied to every column. This can be fixed by adding `.Value = .Value` to remove the formulas. I updated the code with variables to show how to accomplish this. – GMalc Oct 23 '19 at 19:39