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