Fill Formula Down Column

[rachel06]

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

   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)"

 

[Joe4]

Can you show us a small sample of your data and expected outcome?

 

[rachel06]

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
	L	M
1	File Name	Run ID
2	max1537g_473383_HT	473383
3	max1537g_473383_HT
4	max1537g_473383_HT
5	max1537g_473383_HT
6	max1537g_473383_HT
7	max1537g_473383_HT
8	max1537g_473383_HT
9	max1537g_473383_HT
10	max1537g_473383_HT
11	max1537g_473383_HT
12	max1537g_473383_HT
13	max1537g_473383_HT
14	max1537g_473383_HT
1537

Cell Formulas
Range	Formula
M2	M2	=CHOOSECOLS(TEXTSPLIT(L2,"_"),2)

 

[Joe4]

Try this:

    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)"

 

[rachel06]

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

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?

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

 

[Joe4]

Looks like you accidentally changed "lr" to "LastRow", which you have not defined anywhere:

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.)

 

[rachel06]

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.

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

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

 

[MARK858]

What happens if you change the line to.....

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

 

[rachel06]

Boom. That worked. Thanks so much to both of you!!

 

[Joe4]

Note, you can simplify things if you use Worksheet variables, i.e.

Dim ws1 as Worksheet
Set ws1 = Sheets("1537")

Then instead of this:

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:

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