Excel Macro generating single random output - vba

I recorded a macro that runs through a bunch of formatting and splicing of data. It basically formats the data page, then splices it into months. The data roughly looks like this:
Column A ... Column D ... Column H Column I Jan Feb ... Nov Dec
- 00645 - budget 45.2 32.8 -15.0 100.00
Basically it fills in entries for all of column A (all entries are "LINE"), renames header on columns B, C, D, H, and I, then copys columns A-J and moves it to a tab created just for the specific month, then deletes column J so the next month will always be in column J and continues repeating till all months are parsed out. Its a pretty easy macro, mostly recorded, but its behaving strangely.
The issue is that once it runs, it randomly inputs the value that is only supposed to be in column A ("LINE") to a single cell somewhere else in the file. It seems semi-random which cell it is. If you put in data from File A, no matter how many times you run the macro "LINE" will show up in the same cell. But it will be a different cell for Files B, C, D and so on. There is nothing fundamentially different about the cell it does this in when compared to the other cells (same entry, same formatting, etc). I have no idea why its doing this. Below is my code:
Sub Format_Upload()
Format_Upload Macro
ActiveCell.FormulaR1C1 = "LINE"
LastRow = Range("B" & Rows.Count).End(xlUp).Row
Range("A2").Copy Range("A2").Resize(LastRow - 1)
Range("B1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "Dept ID"
Range("C1").Select
ActiveCell.FormulaR1C1 = "MSUPLOAD1"
Range("D1").Select
ActiveCell.FormulaR1C1 = "01/01/14"
Range("I1").Select
ActiveCell.FormulaR1C1 = "01/01/14"
Range("D1").Select
Selection.NumberFormat = "mm/dd/yy;#"
Range("I1").Select
Selection.NumberFormat = "mm/dd/yy;#"
Cells.Select
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("J:U").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Selection.NumberFormat = "0.00"
Columns("A:J").Select
Selection.Copy
Sheets("JAN").Select
Range("A1").Select
ActiveSheet.Paste
Sheets("Data").Select
Columns("J:J").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Columns("A:J").Select
Selection.Copy
Sheets("FEB").Select
Range("A1").Select
ActiveSheet.Paste
Range("D1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "2/1/2014"
Range("I1").Select
ActiveCell.FormulaR1C1 = "2/1/2014"
Range("H1").Select
Sheets("Data").Select
Columns("J:J").Select
Selection.Delete Shift:=xlToLeft
Columns("A:J").Select
Selection.Copy
Sheets("MAR").Select
Range("A1").Select
ActiveSheet.Paste
Range("D1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "3/1/2014"
Range("I1").Select
ActiveCell.FormulaR1C1 = "3/1/2014"
Range("I2").Select
Sheets("Data").Select
Columns("J:J").Select
Selection.Delete Shift:=xlToLeft
Columns("A:J").Select
Selection.Copy
Sheets("APR").Select
ActiveSheet.Paste
Range("D1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "4/1/2014"
Range("I1").Select
ActiveCell.FormulaR1C1 = "4/1/2014"
Range("I2").Select
Sheets("Data").Select
Columns("J:J").Select
Selection.Delete Shift:=xlToLeft
Columns("A:J").Select
Range("J1").Activate
Selection.Copy
Sheets("MAY").Select
ActiveSheet.Paste
Range("D1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "5/1/2014"
Range("I1").Select
ActiveCell.FormulaR1C1 = "5/1/2014"
Range("I2").Select
Sheets("Data").Select
Columns("J:J").Select
Selection.Delete Shift:=xlToLeft
Columns("A:J").Select
Selection.Copy
Sheets("JUN").Select
ActiveSheet.Paste
Range("D1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "6/1/2014"
Range("I1").Select
ActiveCell.FormulaR1C1 = "6/1/2014"
Range("I2").Select
Sheets("Data").Select
Columns("J:J").Select
Selection.Delete Shift:=xlToLeft
Columns("A:J").Select
Selection.Copy
Sheets("JUL").Select
ActiveSheet.Paste
Range("D1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "7/1/2014"
Range("I1").Select
ActiveCell.FormulaR1C1 = "7/1/2014"
Range("I2").Select
Sheets("Data").Select
Columns("J:J").Select
Selection.Delete Shift:=xlToLeft
Columns("A:J").Select
Selection.Copy
Sheets("AUG").Select
ActiveSheet.Paste
Range("D1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "8/1/2014"
Range("I1").Select
ActiveCell.FormulaR1C1 = "8/1/2014"
Range("I2").Select
Sheets("Data").Select
Columns("J:J").Select
Selection.Copy
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Columns("A:J").Select
Selection.Copy
Sheets("SEP").Select
ActiveSheet.Paste
Range("D1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "9/1/2014"
Range("I1").Select
ActiveCell.FormulaR1C1 = "9/1/2014"
Range("I2").Select
Sheets("Data").Select
Columns("J:J").Select
Selection.Delete Shift:=xlToLeft
Selection.Copy
Sheets("OCT").Select
Sheets("Data").Select
Columns("A:J").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("OCT").Select
Range("A1").Select
ActiveSheet.Paste
Range("D1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "10/1/2014"
Range("I1").Select
ActiveCell.FormulaR1C1 = "10/1/2014"
Range("I2").Select
Sheets("Data").Select
Columns("J:J").Select
Selection.Delete Shift:=xlToLeft
Columns("A:J").Select
Selection.Copy
Sheets("NOV").Select
ActiveSheet.Paste
Range("D1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "11/1/2014"
Range("I1").Select
ActiveCell.FormulaR1C1 = "11/1/2014"
Range("I2").Select
Sheets("Data").Select
Columns("J:J").Select
Selection.Delete Shift:=xlToLeft
Columns("A:J").Select
Selection.Copy
Sheets("DEC").Select
ActiveSheet.Paste
Columns("D:D").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "12/1/2014"
Range("I1").Select
ActiveCell.FormulaR1C1 = "12/1/2014"
Range("I2").Select
Sheets("Data").Select
Columns("J:J").Select
Selection.Delete Shift:=xlToLeft
Sheets("FEB").Select
ActiveCell.FormulaR1C1 = "MSFEB"
Sheets("MAR").Select
Range("H1").Select
ActiveCell.FormulaR1C1 = "MSMAR"
Sheets("APR").Select
Range("H1").Select
ActiveCell.FormulaR1C1 = "MSAPR"
Sheets("MAY").Select
Range("H1").Select
ActiveCell.FormulaR1C1 = "MSMAY"
Sheets("JUN").Select
Range("H1").Select
ActiveCell.FormulaR1C1 = "MSJUN"
Sheets("JUL").Select
Range("H1").Select
ActiveCell.FormulaR1C1 = "MSJUL"
Sheets("AUG").Select
Range("H1").Select
ActiveCell.FormulaR1C1 = "MSAUG"
Sheets("SEP").Select
Range("H1").Select
ActiveCell.FormulaR1C1 = "MSSEP"
Sheets("OCT").Select
Range("H1").Select
ActiveCell.FormulaR1C1 = "MSOCT"
Sheets("NOV").Select
Range("H1").Select
ActiveCell.FormulaR1C1 = "MSNOV"
Sheets("DEC").Select
Range("H1").Select
ActiveCell.FormulaR1C1 = "MSDEC"
Range("H2").Select
End Sub
I do not see anything in the code that explains this anomaly. Any ideas as to what's causing this issue?
'
EDIT: The strange cell always appears on the first tab (named "JAN"), but its location varies.

ActiveCell.FormulaR1C1 = "LINE"
This is putting "LINE" in whichever cell you have selected before running it.
Change that to something else

Related

Excel VBA Loop?

I am new to creating VBA macros. I recorded the macro below, but I need this done for 18 other worksheets in the workbook. I do not know how to create a loop. Can it be done from this recorded macro? Sorry for the long code. Again this code is used on 18 other worksheets and am unsure how to create a loop.
Sheets("C3 CONW INW OPIS_CMA").Select
Range("G1").Select
ActiveCell.FormulaR1C1 = "PSTRIK"
Range("A1").Select
ActiveCell.FormulaR1C1 = "PRECID"
Range("A2").Select
ActiveCell.FormulaR1C1 = "P"
Range("A2").Select
Selection.AutoFill Destination:=Range("A2:A26"), Type:=xlFillDefault
Range("A2:A26").Select
Range("C1").Select
ActiveCell.FormulaR1C1 = "PEXCH"
Range("C2").Select
ActiveCell.FormulaR1C1 = "7"
Range("C2").Select
Selection.AutoFill Destination:=Range("C2:C26"), Type:=xlFillDefault
Range("C2:C26").Select
Columns("O:O").Select
Selection.Delete Shift:=xlToLeft
Columns("N:N").Select
Selection.Delete Shift:=xlToLeft
Columns("E:E").Select
Selection.Delete Shift:=xlToLeft
Columns("J:J").Select
Selection.Delete Shift:=xlToLeft
Columns("D:D").Select
Selection.Delete Shift:=xlToLeft
Columns("E:E").Select
Selection.Cut
Columns("G:G").Select
Selection.Insert Shift:=xlToRight
Columns("I:I").Select
Selection.Cut
Columns("K:K").Select
Selection.Insert Shift:=xlToRight
Range("I1").Select
ActiveCell.FormulaR1C1 = "PQTY"
Range("G1").Select
ActiveCell.FormulaR1C1 = "PCTYM"
Range("D1").Select
ActiveCell.FormulaR1C1 = "PFC"
Range("B1").Select
ActiveCell.FormulaR1C1 = "PACCT"
Range("J1").Select
ActiveCell.FormulaR1C1 = "PPRTCP"
Range("E1").Select
ActiveCell.FormulaR1C1 = "PSUBTY"
Range("H1").Select
ActiveCell.FormulaR1C1 = "PSBUS"
Range("H2").Select
ActiveCell.FormulaR1C1 = "0"
Selection.AutoFill Destination:=Range("H2:H23"), Type:=xlFillDefault
Range("H2:H23").Select
Columns("I:I").Select
Range("I240").Activate
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("I1").Select
ActiveCell.FormulaR1C1 = "PBS"
Range("I2").Select
ActiveCell.FormulaR1C1 = "1"
Selection.AutoFill Destination:=Range("I2:I23"), Type:=xlFillDefault
Range("I2:I23").Select
Again sorry for the format of the code.
I cleaned up your code a bit, and put it into a sub which takes a worksheet as its argument. I then made another sub which loops through all the worksheets of the workbook the code resides in, and makes the changes specified.
Option Explicit
Sub test()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
Call fix_stuff_in_the_sheet(ws)
Next ws
End Sub
Sub fix_stuff_in_the_sheet(ws As Worksheet)
ws.Range("G1").FormulaR1C1 = "PSTRIK"
ws.Range("A1").FormulaR1C1 = "PRECID"
ws.Range("A2").FormulaR1C1 = "P"
ws.Range("A2").AutoFill Destination:=Range("A2:A26"), Type:=xlFillDefault
ws.Range("A2:A26").FormulaR1C1 = "PEXCH"
ws.Range("C2").FormulaR1C1 = "7"
ws.Range("C2").AutoFill Destination:=Range("C2:C26"), Type:=xlFillDefault
ws.Columns("N:O").Delete Shift:=xlToLeft
ws.Columns("E:E").Delete Shift:=xlToLeft
ws.Columns("J:J").Delete Shift:=xlToLeft
ws.Columns("D:D").Delete Shift:=xlToLeft
ws.Columns("E:E").Cut
ws.Columns("G:G").Insert Shift:=xlToRight
ws.Columns("I:I").Cut
ws.Columns("K:K").Insert Shift:=xlToRight
ws.Range("I1").FormulaR1C1 = "PQTY"
ws.Range("G1").FormulaR1C1 = "PCTYM"
ws.Range("D1").FormulaR1C1 = "PFC"
ws.Range("B1").FormulaR1C1 = "PACCT"
ws.Range("J1").FormulaR1C1 = "PPRTCP"
ws.Range("E1").FormulaR1C1 = "PSUBTY"
ws.Range("H1").FormulaR1C1 = "PSBUS"
ws.Range("H2").FormulaR1C1 = "0"
ws.Range("H2").AutoFill Destination:=Range("H2:H23"), Type:=xlFillDefault
ws.Range("I240").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
ws.Range("I1").FormulaR1C1 = "PBS"
ws.Range("I2").FormulaR1C1 = "1"
ws.Range("I2").AutoFill Destination:=Range("I2:I23"), Type:=xlFillDefault
End Sub
If you don't want the code to be performed on all the sheets in your workbook, you need to figure out a way for the first function to only be called with the sheets you want as an argument.
There is still some superfluous code in the subs I post here, e.g. you first autofill range A2:A26 with the letter P, but then later overwrites that with PEXCH. I'll leave it to you to weed out this though.

Coding certain cells a color

How do I code something to say: If the total amount is under $1000 (E11:E28) then it will turn red? Also, is there a way to clean up this vba so that it's no so lengthy?
This is a project that I want to teach my students to do as a way to do some basic budgeting.
Here is my current code:
Sub ClassroomSupplies()
Range("A7").Select
ActiveCell.FormulaR1C1 = "Week of July 2-6, 2018"
Range("A10").Select
Columns("B:B").ColumnWidth = 9.57
Range("A8:B8").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
Range("A10").Select
ActiveCell.FormulaR1C1 = "AMOUNT"
Range("B10").Select
ActiveCell.FormulaR1C1 = "SALES"
Range("C10").Select
ActiveCell.FormulaR1C1 = "PRICE PER UNIT"
Range("D10").Select
ActiveCell.FormulaR1C1 = "TAX"
Range("E10").Select
ActiveCell.FormulaR1C1 = "TOTAL"
Range("A11").Select
ActiveCell.FormulaR1C1 = "Calculators"
Range("A12").Select
ActiveCell.FormulaR1C1 = "Pencils"
Range("A13").Select
ActiveCell.FormulaR1C1 = "Loose Leaf Paper"
Range("A14").Select
ActiveCell.FormulaR1C1 = "Balloons"
Range("A15").Select
ActiveCell.FormulaR1C1 = "Mirrors"
Range("A16").Select
ActiveCell.FormulaR1C1 = "Axles"
Range("A17").Select
ActiveCell.FormulaR1C1 = "Wheels"
Range("A18").Select
ActiveCell.FormulaR1C1 = "Masking Tape"
Range("A19").Select
ActiveCell.FormulaR1C1 = "Electrical Tape"
Range("A20").Select
ActiveCell.FormulaR1C1 = "Mini Blocks"
Range("A21").Select
ActiveCell.FormulaR1C1 = "Tongue Depressors"
Range("A22").Select
ActiveCell.FormulaR1C1 = "Slinkys"
Range("A23").Select
ActiveCell.FormulaR1C1 = "Beakers"
Range("A24").Select
ActiveCell.FormulaR1C1 = "Test Tubes"
Range("A25").Select
ActiveCell.FormulaR1C1 = "Colored Pencils"
Range("A26").Select
ActiveCell.FormulaR1C1 = "Lenses"
Range("A27").Select
ActiveCell.FormulaR1C1 = "Newspapers"
Range("A28").Select
ActiveCell.FormulaR1C1 = "Cardboard"
Range("B11").Select
ActiveCell.FormulaR1C1 = "10392"
Range("B12").Select
ActiveCell.FormulaR1C1 = "10788"
Range("B13").Select
ActiveCell.FormulaR1C1 = "15588"
Range("B14").Select
ActiveCell.FormulaR1C1 = "1188"
Range("B15").Select
ActiveCell.FormulaR1C1 = "5970"
Range("B16").Select
ActiveCell.FormulaR1C1 = "8970"
Range("B17").Select
ActiveCell.FormulaR1C1 = "7980"
Range("B18").Select
ActiveCell.FormulaR1C1 = "5990"
Range("B19").Select
ActiveCell.FormulaR1C1 = "2970"
Range("B20").Select
ActiveCell.FormulaR1C1 = "4788"
Range("B21").Select
ActiveCell.FormulaR1C1 = "3192"
Range("B22").Select
ActiveCell.FormulaR1C1 = "6487"
Range("B23").Select
ActiveCell.FormulaR1C1 = "490"
Range("B24").Select
ActiveCell.FormulaR1C1 = "490"
Range("B25").Select
ActiveCell.FormulaR1C1 = "15684"
Range("B26").Select
ActiveCell.FormulaR1C1 = "80"
Range("B27").Select
ActiveCell.FormulaR1C1 = "100"
Range("B28").Select
ActiveCell.FormulaR1C1 = "95"
Range("B29").Select
Range("C11:C28").Select
Selection.Style = "Currency"
Range("D11").Select
ActiveCell.FormulaR1C1 = "=SUM((RC[-2]*RC[-1])*0.0625)"
Range("D11").Select
Selection.AutoFill Destination:=Range("D11:D28"), Type:=xlFillDefault
Range("D11:D28").Select
Selection.Style = "Currency"
Range("E11").Select
ActiveCell.FormulaR1C1 = "=SUM((RC[-3]*RC[-2])+RC[-1])"
Range("E11").Select
Selection.AutoFill Destination:=Range("E11:E28"), Type:=xlFillDefault
Range("E11:E28").Select
Range("E31").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-20]C:R[-3]C)"
ActiveCell.FormulaR1C1 = "=SUM(R[-20]C:R[-3]C)"
Range("E34").Select
ActiveCell.FormulaR1C1 = "=AVERAGE(R[-3]C/5)"
Range("E35").Select
End Sub
Any help would be greatly appreciated.
Thanks!
Try,
'this to set a conditional formatting rule on E11:E28
with range("E11:E28")
.FormatConditions.Delete
With .FormatConditions.Add(Type:=xlExpression, Formula1:="=and(len($e11), $e11<1000)")
.Interior.Color = vbred
End With
end with
'this should get you started cleaning up the text labels
Range("A10:E10") = array("AMOUNT","SALES","PRICE PER UNIT","TAX","TOTAL")
Range("A11:A28") = application.transpose(array("Calculators","Pencils","Loose Leaf Paper", _
"Balloons","Mirrors","Axles","Wheels","Masking Tape", _
"Electrical Tape","Mini Blocks","Tongue Depressors", _
"Slinkys","Beakers","Test Tubes","Colored Pencils", _
"Lenses","Newspapers","Cardboard"))
Note that filling in a number of columns in a single row only requires passing the array into the range but to fill in a number of rows in a single column you must Transpose the array.
Please read How to avoid using Select in Excel VBA.

Taking only the first 100 resulted rows each time when a criteria is True

Does anyone know how to take only the first 100 resulted rows each time when this is True?:
=COUNTIFS(R2C9:R50000C9,RC[-1])>30?
I have a sheet with 9 columns A-I. The column I that is Amount has values from 1-1600 kg and only increases. At some times remains stable for further than 30 seconds. I would like to collect these data when the amount is stable, but I only need the first 100 rows of every time when the amount is stable. I don't want only the first 100 rows when the criteria is True, because in this way it gives me only the 100 rows of the first time when the amount("I") is stable.
Thank you in advance.
This is my code:
Sub philoly_3()
'
' philoly_3 Macro
'
Sheets("Graph data").Select
Range("J1").Select
Selection.NumberFormat = "0.00"
ActiveCell.FormulaR1C1 = "Criteria"
Range("J2").Select
ActiveCell.FormulaR1C1 = "=COUNTIFS(R2C9:R50000C9,RC[-1])>30"
Range("J2").Select
Selection.AutoFill Destination:=Range("J2:J50000")
Range("J2:J50000").Select
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Style = "Input"
Range("F2").Select
With ActiveWindow
.SplitColumn = 0
.SplitRow = 1
End With
ActiveWindow.FreezePanes = True
Selection.AutoFilter
ActiveSheet.Range("$A$1:$J$50000").AutoFilter Field:=10, Criteria1:="TRUE"
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range("A1:I1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("All moments").Select
ActiveSheet.Paste
Cells.Select
Cells.EntireColumn.AutoFit
Range("F2").Select
With ActiveWindow
.SplitColumn = 0
.SplitRow = 1
End With
ActiveWindow.FreezePanes = True
Sheets("All moments").Select
Application.CutCopyMode = False
Sheets("All moments").Move Before:=Sheets(1)
Sheets("Graph data").Select
ActiveSheet.Range("$A$1:$J$50000").AutoFilter Field:=10
Range("I50000").Select
Selection.End(xlUp).Select
Range("I2").Select
Selection.AutoFilter
Columns("J:J").Select
Selection.Delete Shift:=xlToLeft
Range("B2").Select
philoly_11
End Sub

Macro to Auto Fill Down to last adjacent cells

I want my macro to populate my formulas all the way down the sheet. Every time I run the macro it stops at row 13662 because that was the last row when I was recording it, but the last row changes constantly. Is there a way to do this?
The columns I need to do this for are N, I, J, K, and L. Any help appreciated. See code below.
Sub Weekly_Expiring_Rebate_Report()
'
' Weekly_Expiring_Rebate_Report Macro
'
'
Columns("A:A").Select
Range(Selection, Selection.End(xlToRight)).Select
With Selection
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("A:A").Select
Range(Selection, Selection.End(xlToRight)).Select
Columns("A:Z").EntireColumn.AutoFit
Columns("N:N").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.NumberFormat = "General"
Range("N1").Select
ActiveCell.FormulaR1C1 = "Expiring Rebate Status"
Range("N2").Select
Columns("N:N").EntireColumn.AutoFit
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],'Status IND'!C[-13]:C[-11],3,FALSE)"
Range("N2").Select
Selection.AutoFill Destination:=Range("N2:N13662")
Range("N2:N13662").Select
Columns("I:I").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("I2").Select
ActiveCell.FormulaR1C1 = "=LEFT(RC[-1],4)"
Range("I2").Select
Selection.AutoFill Destination:=Range("I2:I13662")
Range("I2:I13662").Select
Range("J2").Select
ActiveCell.FormulaR1C1 = "=LEFT(RC[-2],6)"
Range("J2").Select
Selection.AutoFill Destination:=Range("J2:J13662")
Range("J2:J13662").Select
Range("K2").Select
ActiveCell.FormulaR1C1 = "=RIGHT(RC[-1],2)"
Range("K2").Select
Selection.AutoFill Destination:=Range("K2:K13662")
Range("K2:K13662").Select
Range("L2").Select
ActiveCell.FormulaR1C1 = "=RIGHT(RC[-4],2)"
Range("L2").Select
Selection.AutoFill Destination:=Range("L2:L13662")
Range("L2:L13662").Select
Range("I1").Select
ActiveCell.FormulaR1C1 = "EXP_YEAR"
Range("K1").Select
ActiveCell.FormulaR1C1 = "EXP_MONTH"
Range("L1").Select
ActiveCell.FormulaR1C1 = "EXP_DAY"
Columns("I:L").Select
Range("L1").Activate
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("J:J").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Range("L1").Select
ActiveCell.FormulaR1C1 = "EXP_Month_Name"
Columns("I:L").Select
Range("L1").Activate
Columns("I:L").EntireColumn.AutoFit
Range("L2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-2],Month!C[-11]:C[-10],2,FALSE)"
Range("L2").Select
Selection.AutoFill Destination:=Range("L2:L13662")
Range("L2:L13662").Select
ActiveWindow.SmallScroll Down:=-6
Columns("M:M").Select
End Sub
It looks like your issue is on the 5th row from the end.
Based on this answer you could replace:
Selection.AutoFill Destination:=Range("L2:L13662")
with
Selection.AutoFill Destination:=Range("L2:L" & ActiveSheet.UsedRange.Rows.Count)
Here is an example of vba code that I think will work for your purposes.
'Counts the number of rows in column "C" and then places
'concatenation formula in each adjacent cell (in column "D").
Range("D2:D" & Range("C" & Rows.Count).End(xlUp).Row).Formula = "=CONCATENATE(C2,"", "",B2)"

MID and CONCATENATE in VBA

I'm having the following issue: I recorded a Macro of me using some MID and CONCATENATE formulas after my macro reorders a ton of data. When I run the macro, I get a #REF error, which I understand. However, is there a VBA Code that could remove that or somehow use the MID and CONCATENATE without creating the #REF error? My code is below and any help would be much appreciated.
Sub Macro4()
'
' Macro4 Macro
'
'
Sheets("Sheet2").Select
Cells.Select
Range("D29").Activate
Selection.ClearContents
Selection.End(xlUp).Select
Selection.End(xlToLeft).Select
Sheets("Sheet1").Select
'
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(1, 1), Array(16, 1), Array(21, 1), Array(37, 1), _
Array(42, 1), Array(58, 1), Array(63, 1), Array(79, 1), Array(84, 1), Array(100, 1), Array( _
105, 1), Array(121, 1), Array(129, 1)), TrailingMinusNumbers:=True
Rows("1:6").Select
Selection.Delete Shift:=xlUp
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
Columns("B:B").Select
Selection.Delete Shift:=xlToLeft
Columns("C:C").Select
Selection.Delete Shift:=xlToLeft
Columns("D:D").Select
Selection.Delete Shift:=xlToLeft
Columns("E:E").Select
Selection.Delete Shift:=xlToLeft
Columns("F:F").Select
Selection.Delete Shift:=xlToLeft
Columns("G:G").Select
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Dim lastRow&, g&
Dim findStr$
findStr = "Planning of"
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
For g = lastRow To 1 Step -1 ' change this to 2 if you have headers
If Cells(g, 1).Value = findStr Then
'Range(Rows(i), Rows(i - 4)).Select
Range(Rows(g), Rows(g - 4)).EntireRow.Delete
End If
Next g
Dim arr() As Variant
Dim p As Integer, i&
Dim ws As Worksheet
Dim tws As Worksheet
Dim t As Integer
Dim c As Long
Dim u As Long
Set ws = ActiveSheet
Set tws = Worksheets("Sheet2")
i = 1
With ws
Do Until i > 100000
u = 0
For c = 1 To .Cells(1, .Columns.Count).End(xlToLeft).Column
'If c = .Cells(1, .Columns.Count).End(xlToLeft).Column And .Cells(i, c) <> "" Then
ReDim arr(0) As Variant
p = 0
t = 0
Do Until .Cells(i + p, c) = "" And t = 1
If .Cells(i + p, c) = "" Then
t = 1
Else
arr(UBound(arr)) = .Cells(i + p, c)
ReDim Preserve arr(UBound(arr) + 1)
End If
p = p + 1
Loop
If p > u Then
u = p
End If
If c = .Cells(1, .Columns.Count).End(xlToLeft).Column Then
If .Cells(i + p, c).End(xlDown).Row > 100000 And .Cells(i + p, 1).End(xlDown).Row < 100000 Then
i = .Cells(i + u, 1).End(xlDown).Row
Else
i = .Cells(i + p, c).End(xlDown).Row
End If
End If
tws.Cells(tws.Rows.Count, 1).End(xlUp).Offset(1).Resize(, UBound(arr) + 1) = arr
Next c
Loop
End With
With tws
.Rows(1).Delete
For i = .Cells(1, 1).End(xlDown).Row To 2 Step -1
If Left(.Cells(i, 1), 4) <> Left(.Cells(i - 1, 1), 4) Then
.Rows(i).EntireRow.Insert
End If
Next i
End With
'
' Macro6 Macro
'
'
'Sheets("Sheet2").Select
'Range("A1:M67").Select
'Selection.Copy
'Sheets("Output").Select
'Range("A3").Select
'ActiveSheet.Paste
'Range("A1").Select
ActiveCell.FormulaR1C1 = "=IF(Sheet2!RC="""","""",Sheet2!RC)"
Range("B1").Select
ActiveCell.FormulaR1C1 = "=MID(Sheet2!RC[1],5,4)"
Range("C1").Select
ActiveCell.FormulaR1C1 = "=MID(Sheet2!RC,1,3)"
Range("D1").Select
ActiveCell.FormulaR1C1 = "=MID(Sheet2!RC,6,3)"
Range("E1").Select
ActiveCell.FormulaR1C1 = "=MID(Sheet2!RC[-1],1,4)"
Range("F1").Select
ActiveCell.FormulaR1C1 = "=MID(Sheet2!RC[-2],10,4)"
Range("F2").Select
Columns("F:F").EntireColumn.AutoFit
Range("G1").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-3]="""","""",RC[-3])"
Range("H1").Select
ActiveCell.FormulaR1C1 = "=MID(Sheet2!RC[-3],5,3)"
Range("H1").Select
ActiveCell.FormulaR1C1 = "=MID(Sheet2!RC[-3],6,3)"
Range("I1").Select
ActiveCell.FormulaR1C1 = "=MID(Sheet2!RC[-4],1,4)"
Range("J1").Select
ActiveCell.FormulaR1C1 = "=MID(Sheet2!RC[-5],10,4)"
Range("K1").Select
ActiveCell.FormulaR1C1 = "=MID(Sheet2!RC[-5],6,3)"
Range("K2").Select
Columns("K:K").EntireColumn.AutoFit
Range("G1").Select
Selection.Copy
Range("K1").Select
ActiveSheet.Paste
Range("L1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=MID(Sheet2!RC[-6],6,3)"
Range("M1").Select
ActiveCell.FormulaR1C1 = "=MID(Sheet2!RC[-7],1,4)"
Range("N1").Select
ActiveCell.FormulaR1C1 = "=MID(Sheet2!RC[-8],10,4)"
Range("O1").Select
ActiveCell.FormulaR1C1 = ""
Range("K1").Select
Selection.Copy
Range("O1").Select
ActiveSheet.Paste
Range("O1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=IF(RC[-3]="""","""",RC[-3])"
Range("P1").Select
Columns("P:P").ColumnWidth = 7.71
ActiveCell.FormulaR1C1 = "=MID(Sheet2!RC[-9],6,3)"
Range("Q1").Select
ActiveCell.FormulaR1C1 = "=MID(Sheet2!RC[-10],1,4)"
Range("R1").Select
ActiveCell.FormulaR1C1 = "=MID(Sheet2!RC[-11],10,4)"
Range("O1").Select
Selection.Copy
Range("S1").Select
ActiveSheet.Paste
Range("T1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=MID(Sheet2!RC[-12],6,3)"
Range("U1").Select
ActiveCell.FormulaR1C1 = "=MID(Sheet2!RC[-13],1,4)"
Range("V1").Select
ActiveCell.FormulaR1C1 = "=MID(Sheet2!RC[-14],10,3)"
Range("V1").Select
ActiveCell.FormulaR1C1 = "=MID(Sheet2!RC[-14],10,4)"
Range("V2").Select
Columns("U:U").EntireColumn.AutoFit
Range("S1").Select
Selection.Copy
Range("W1").Select
ActiveSheet.Paste
Range("X1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=MID(Sheet2!RC[-15],6,3)"
Range("Y1").Select
ActiveCell.FormulaR1C1 = "=MID(Sheet2!R[10]C[-16],1,4)"
Range("Y1").Select
ActiveCell.FormulaR1C1 = "=MID(Sheet2!RC[-16],1,4)"
Range("Z1").Select
ActiveCell.FormulaR1C1 = ""
Range("W1").Select
Selection.Copy
Range("Z1").Select
ActiveSheet.Paste
Range("Z1").Select
Columns("Z:Z").EntireColumn.AutoFit
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=MID(Sheet2!RC[-17],10,4)"
Range("AA1").Select
ActiveCell.FormulaR1C1 = ""
Range("W1").Select
Selection.Copy
Range("AA1").Select
ActiveSheet.Paste
Range("AB1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=MID(Sheet2!RC[-18],6,3)"
Range("AC1").Select
ActiveCell.FormulaR1C1 = "=Sheet2!R[113]C[-19]"
Range("AC1").Select
ActiveCell.FormulaR1C1 = "eet2!J114"
Range("AC1").Select
ActiveCell.FormulaR1C1 = "=MID(Sheet2!RC[-19],1,4)"
Range("AA1").Select
Selection.Copy
Range("AD1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=MID(Sheet2!RC[-20],10,4)"
Range("W1").Select
Selection.Copy
Range("AD1").Select
ActiveSheet.Paste
Range("AD1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=IF(OR(RC[-3]="""",AE=""""),"""",RC[-3])"
Range("AD1").Select
ActiveCell.FormulaR1C1 = "=IF(OR(RC[-3]="""",RC[1]=""""),"""",RC[-3])"
Range("A1:AD1").Select
Selection.AutoFill Destination:=Range("A1:AD123"), Type:=xlFillDefault
Range("A1:AD123").Select
ActiveWindow.SmallScroll Down:=-108
Range("V23").Select
ActiveWindow.SmallScroll Down:=-21
Columns("AD:AD").Select
Selection.Copy
Columns("G:G").Select
ActiveSheet.Paste
Columns("K:K").Select
ActiveSheet.Paste
Columns("O:O").Select
ActiveSheet.Paste
Columns("S:S").Select
ActiveSheet.Paste
Columns("W:W").Select
ActiveSheet.Paste
Columns("AA:AA").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=-27
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.End(xlToLeft).Select
Sheets("Sheet4").Select
Range("A3").Select
ActiveWindow.SmallScroll Down:=-6
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=IF(Sheet3!R[-2]C="""","""",Sheet3!R[-2]C)"
Range("B3").Select
ActiveCell.FormulaR1C1 = _
"=CONCATENATE(Sheet3!R[-2]C,"" "",Sheet3!R[-2]C[1],Sheet3!R[-2]C[2],"" "",Sheet3!R[-2]C[3])"
Range("B3").Select
Selection.Copy
Range("C3").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = _
"=CONCATENATE(Sheet3!R[-2]C[3],"" "",Sheet3!R[-2]C[4],Sheet3!R[-2]C[5],"" "",Sheet3!R[-2]C[6])"
Range("D3").Select
ActiveCell.FormulaR1C1 = _
"=CONCATENATE(Sheet3!R[-2]C[6],"" "",Sheet3!R[-2]C[7],Sheet3!R[-2]C[8],"" "",Sheet3!R[-2]C[9])"
Range("E3").Select
ActiveCell.FormulaR1C1 = _
"=CONCATENATE(Sheet3!R[-2]C[9],"" "",Sheet3!R[-2]C[10],Sheet3!R[-2]C[11],"" "",Sheet3!R[-2]C[12])"
Range("F3").Select
ActiveCell.FormulaR1C1 = _
"=CONCATENATE(Sheet3!R[-2]C[12],"" "",Sheet3!R[-2]C[13],Sheet3!R[-2]C[14],"" "",Sheet3!R[-2]C[15])"
Range("G3").Select
ActiveCell.FormulaR1C1 = _
"=CONCATENATE(Sheet3!R[-2]C[15],"" "",Sheet3!R[-2]C[16],Sheet3!R[-2]C[17], ,Sheet3!R[-2]C[18])"
Range("G3").Select
ActiveCell.FormulaR1C1 = _
"=CONCATENATE(Sheet3!R[-2]C[15],"" "",Sheet3!R[-2]C[16],Sheet3!R[-2]C[17],"" "",Sheet3!R[-2]C[18])"
Range("H3").Select
ActiveCell.FormulaR1C1 = _
"=CONCATENATE(Sheet3!R[-2]C[18],"" "",Sheet3!R[-2]C[19],Sheet3!R[-2]C[20],"" "")"
Range("H3").Select
ActiveCell.FormulaR1C1 = _
"=CONCATENATE(Sheet3!R[-2]C[18],"" "",Sheet3!R[-2]C[19],Sheet3!R[-2]C[20],"" "",Sheet3!R[-2]C[21])"
Range("H4").Select
Sheets("Sheet3").Select
ActiveWindow.SmallScroll Down:=-12
Sheets("Sheet4").Select
Range("A3:H3").Select
Selection.AutoFill Destination:=Range("A3:H193"), Type:=xlFillDefault
Range("A3:H193").Select
ActiveWindow.SmallScroll Down:=-201
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Output").Select
Range("A1").Select
ActiveWindow.SmallScroll Down:=-12
Sheets("Sheet4").Select
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet4").Select
ActiveWindow.SmallScroll Down:=-48
Range("A116").Select
Selection.End(xlUp).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Output").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End Sub
I couldn't figure out how to fix the VBA so I simply ran the code without the MID and CONCATENATE in there. Once I did that, I copy and pasted my results into a new tab and entered the equations.