Fill Formula Down Column

rachel06

Board Regular
Joined
Feb 3, 2016
Messages
180
Office Version
  1. 365
Platform
  1. Windows
Hi,

I have a macro that cuts down a spreadsheet that has an absurd number of columns based on an hlookup. Basically, the user decides what columns they want to keep (by pasting the headers into a sheet) and the macro deletes the rest.

Anyway, in the next empty column, I need to enter the below, then copy the formula down the entire column. Since this column is going to be different based on what fields are kept by the user, I cannot specify a specific column to fill down.

What can I add to this so that the formula will fill down the entire column? I've tried using something with lastrow referencing column A but nothing is working for me.

Any help is appreciated :)

Code:
   Sheets("1537").Range("A1").End(xlToRight).Offset(0, 1).Formula = "Run ID"
   Sheets("1537").Range("A1").End(xlToRight).Offset(1, 0) = "=CHOOSECOLS(TEXTSPLIT(RC[-1],""_""),2)"
 
Can you show us a small sample of your data and expected outcome?
 
Upvote 0
I don't know if this gives you enough, but in this case, column L is the furthest to the right, so the macro added "Run ID" in M1 and a formula in M2, and I need that formula to copy down the length of column L.

Again, it might not always be column L, so I cannot specifically reference that column.

WIP-HT with 1537s.xlsm
LM
1File NameRun ID
2max1537g_473383_HT473383
3max1537g_473383_HT
4max1537g_473383_HT
5max1537g_473383_HT
6max1537g_473383_HT
7max1537g_473383_HT
8max1537g_473383_HT
9max1537g_473383_HT
10max1537g_473383_HT
11max1537g_473383_HT
12max1537g_473383_HT
13max1537g_473383_HT
14max1537g_473383_HT
1537
Cell Formulas
RangeFormula
M2M2=CHOOSECOLS(TEXTSPLIT(L2,"_"),2)
 
Upvote 0
Try this:
VBA Code:
    Dim lr As Long
    Dim lc As Long
   
'   Find last row in column A with data
    lr = Sheets("1537").Cells(Rows.Count, "A").End(xlUp).Row
   
'   Find last column in row 1 with data
    lc = Sheets("1537").Cells(1, Columns.Count).End(xlToLeft).Column

    Sheets("1537").Cells(1, lc + 1) = "Run ID"
    Sheets("1537").Range(Cells(2, lc + 1), Cells(lr, lc + 1)).FormulaR1C1 = "=CHOOSECOLS(TEXTSPLIT(RC[-1],""_""),2)"
 
Last edited:
Upvote 0
Solution
So this kind of works - it's super close!

Under "Find last column in row 1 with data", had to swtich lr to lc. Only noting that in case someone else comes along and wants to use this :)

This piece of code works on it's own (like when I run it in a module by itself), but not when I run it with the rest of my macro

Code:
Sheets("1537").Range(Cells(2, lc + 1), Cells(lr, lc + 1)).FormulaR1C1 = "=CHOOSECOLS(TEXTSPLIT(RC[-1],""_""),2)"

I get an error that says "Application-defined or object defined error"

Does it have to do with my whole code? This is what it is. Maybe it's because I have both LR and Lastrow?

Code:
Sub cCombine1537()
     Application.ScreenUpdating = False
     
    Dim ws As Worksheet
    Dim wsAll As Worksheet
    Dim Lastrow As Long
    Dim rngSrc As Range
    Dim rngDest As Range
    Dim lr As Long
    Dim lc As Long
    
   
Set wsAll = ThisWorkbook.Worksheets("1537")
If MsgBox("Combine 1537s?", vbYesNo) = vbNo Then Exit Sub



    For Each ws In Worksheets
        Select Case ws.Name
            Case "DASHBOARD", "ALL", "1537", "Headers"
            
            Case Else
                With ws
                    Set rngSrc = .Range("A2:N" & .Range("A" & .Rows.Count).End(xlUp).Row)
                    
                End With
                rngSrc.Copy
                
                With wsAll
                    Lastrow = .Range("A" & .Rows.Count).End(xlUp).Row
                    Set rngDest = .Cells(Lastrow + 1, 1)
                    rngSrc.Copy
                    rngDest.PasteSpecial xlPasteValues
                End With
                End Select
        Next ws

Application.ScreenUpdating = True

    Sheets("1537").Rows("1:1").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Sheets("Headers").Rows("15:15").Copy Destination:=Worksheets("1537").Range("A1")

    
   Sheets("1537").Rows("2:2").Delete Shift:=xlUp
   Sheets("1537").Range("A1").End(xlToRight).Offset(0, 1).Formula = "File Name"
   
   'Find last row in column A with data
    lr = Sheets("1537").Cells(Rows.Count, "A").End(xlUp).Row
    
   'Find last column in row 1 with data
    lc = Sheets("1537").Cells(1, Columns.Count).End(xlToLeft).Column

    Sheets("1537").Cells(1, lc + 1) = "Run ID"
    Sheets("1537").Range(Cells(2, lc + 1), Cells(Lastrow, lc + 1)).FormulaR1C1 = "=CHOOSECOLS(TEXTSPLIT(RC[-1],""_""),2)"
    
    Application.CutCopyMode = False

Sheets("DASHBOARD").Select
  

    
End Sub
 
Upvote 0
Looks like you accidentally changed "lr" to "LastRow", which you have not defined anywhere:
Rich (BB code):
Sheets("1537").Range(Cells(2, lc + 1), Cells(Lastrow, lc + 1)).FormulaR1C1 = "=CHOOSECOLS(TEXTSPLIT(RC[-1],""_""),2)"

(Note: I went back and fixed the typo and updated the "lr" to "lc" in my original posting of the code.)
 
Upvote 0
I had them both defined. I took out LastRow and it's still giving me the same error. The formula line is what is highlighted when I click debug.

Code:
Sub cCombine1537()
     Application.ScreenUpdating = False
     
    Dim ws As Worksheet
    Dim wsAll As Worksheet
    'Dim Lastrow As Long
    Dim rngSrc As Range
    Dim rngDest As Range
    Dim lr As Long
    Dim lc As Long
    
   
Set wsAll = ThisWorkbook.Worksheets("1537")
If MsgBox("Combine 1537s?", vbYesNo) = vbNo Then Exit Sub



    For Each ws In Worksheets
        Select Case ws.Name
            Case "DASHBOARD", "ALL", "1537", "Headers"
            
            Case Else
                With ws
                    Set rngSrc = .Range("A2:N" & .Range("A" & .Rows.Count).End(xlUp).Row)
                    
                End With
                rngSrc.Copy
                
                With wsAll
                    lr = Sheets("1537").Cells(Rows.Count, "A").End(xlUp).Row
                    Set rngDest = .Cells(lr + 1, 1)
                    rngSrc.Copy
                    rngDest.PasteSpecial xlPasteValues
                End With
                End Select
        Next ws

Application.ScreenUpdating = True

    Sheets("1537").Rows("1:1").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Sheets("Headers").Rows("15:15").Copy Destination:=Worksheets("1537").Range("A1")

    
   Sheets("1537").Rows("2:2").Delete Shift:=xlUp
   Sheets("1537").Range("A1").End(xlToRight).Offset(0, 1).Formula = "File Name"
   
   'Find last row in column A with data
    'lr = Sheets("1537").Cells(Rows.Count, "A").End(xlUp).Row
    
   'Find last column in row 1 with data
    lc = Sheets("1537").Cells(1, Columns.Count).End(xlToLeft).Column

    Sheets("1537").Cells(1, lc + 1) = "Run ID"
    Sheets("1537").Range(Cells(2, lc + 1), Cells(lr, lc + 1)).FormulaR1C1 = "=CHOOSECOLS(TEXTSPLIT(RC[-1],""_""),2)"
    
    Application.CutCopyMode = False

Sheets("DASHBOARD").Select
  

    
End Sub


When I pull this into it's own module, it runs just fine. Not sure why it's not playing nice with the rest of the macro

Code:
Sub Macro1()
Dim lr As Long
Dim lc As Long

'   Find last row in column A with data
    lr = Sheets("1537").Cells(Rows.Count, "A").End(xlUp).Row
    
'   Find last column in row 1 with data
    lc = Sheets("1537").Cells(1, Columns.Count).End(xlToLeft).Column

    Sheets("1537").Cells(1, lc + 1) = "Run ID"
    Sheets("1537").Range(Cells(2, lc + 1), Cells(lr, lc + 1)).FormulaR1C1 = "=CHOOSECOLS(TEXTSPLIT(RC[-1],""_""),2)"
End Sub
 
Upvote 0
What happens if you change the line to.....
VBA Code:
Sheets("1537").Range(Sheets("1537").Cells(2, lc + 1), Sheets("1537").Cells(lr, lc + 1)).FormulaR1C1 = "=CHOOSECOLS(TEXTSPLIT(RC[-1],""_""),2)"
 
Upvote 0
Note, you can simplify things if you use Worksheet variables, i.e.

VBA Code:
Dim ws1 as Worksheet
Set ws1 = Sheets("1537")
Then instead of this:
VBA Code:
Sheets("1537").Range(Sheets("1537").Cells(2, lc + 1), Sheets("1537").Cells(lr, lc + 1)).FormulaR1C1 = "=CHOOSECOLS(TEXTSPLIT(RC[-1],""_""),2)"
you can shorten it up to this:
VBA Code:
ws1.Range(ws1.Cells(2, lc + 1), ws1.Cells(lr, lc + 1)).FormulaR1C1 = "=CHOOSECOLS(TEXTSPLIT(RC[-1],""_""),2)"
 
Upvote 0

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