I have a spreadsheet that pulls certain items out of a database by an autofilter macro and puts them into different sections. I have formulas that go in and are autofilled down to every line in each section. The problem I am running into is if a section only has one line my macro will debug. Below is my code that inserts the formulas and autofills them down. The very last row is the autofill macro and the one I need help with. Can someone please provide me an override that says if there is no lines to autofill to just move on to the next step. I'm not sure how this code would go. Thanks
'To insert formulas
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=IF(RC5<'Data Entry'!R2C2,""*"","""")"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=IF(RC18=TRUE,IFERROR(VLOOKUP(RC2,Database!C[-2]:C[9],11,FALSE),""""),0)"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=IFERROR(VLOOKUP(RC2,Database!C[-3]:C[8],10,FALSE),"""")"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=IFERROR((VLOOKUP(RC9,Pull!C1:C5,4,FALSE))*RC4,"""")"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=IFERROR((VLOOKUP(RC9,Pull!C1:C5,5,FALSE))*RC4,"""")"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=IFERROR(SUM(RC4,RC6:RC7),"""")"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=IFERROR(VLOOKUP(RC2,Database!C[-7]:C[4],6,FALSE),"""")"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=IF(RC18=TRUE,IFERROR(VLOOKUP(RC9,'Pull'!C1:C5,2,FALSE),""""),"""")"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=IFERROR(RC8*RC10,"""")"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=IFERROR(RC8+RC11,"""")"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=IFERROR(RC16*R9C13,"""")"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=IF(RC18=TRUE,IFERROR(VLOOKUP(RC9,'Pull'!C1:C5,3,FALSE),""""),"""")"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=IFERROR(RC16*RC14,"""")"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=IFERROR(RC12/(1-R9C13-RC14),"""")"
Range(Cells(Selection.Row, 3), Cells(Selection.Row, 17)).AutoFill Destination:=Range(Cells(Selection.Row, 3), "Q" & Range("B" & Rows.Count).End(xlUp).Row)
I'd set a LastRow variable, calculated the way you already do, and test whether it's greater than the Selection row:
Dim LastRow as Long
LastRow = ActiveSheet.Range("B" & Rows.Count).End(xlUp).Row
...
If LastRow > Selection.Row Then
Range(Cells(Selection.Row, 3), Cells(Selection.Row, 17)).AutoFill Destination:=Range(Cells(Selection.Row, 3), "Q" & LastRow)
EndIf
By the way, if you search on "VBA avoid Select statements" you'll get some info on why that's a good idea and how to do it. In this case I'd set a CellWithFormula variable at the beginning of the code:
Dim CellWithFormula as Excel.Range
Set CellWithFormula = Activcell
CellWithFormula.FormulaR1C1 = "=IF(RC5<'Data Entry'!R2C2,""*"","""")"
Set CellWithFormula = CellWithFormula.Offset(0, 1)
... and so on.
Related
I try
Do
Selection.Offset(1, 0).Select
ActiveCell.FormulaR1C1 = "=R[-1]C+0.01"
Loop Until ActiveCell.Value = "$C$1"
But it's not working
Pls. help
i try to add + 0.01 from first value (1) until equal last value (1.9)
Here is my all code
[Sub ExtractRC()
Range("A2:A" & Range("A2").End(xlDown).Row).Select
Cells(Rows.Count, "A").End(xlUp).Select
Selection.Copy
Range("C1").Select
Selection.PasteSpecial Paste:=xlPasteValues
Range("k2").Select
ActiveCell.FormulaR1C1 = Range("A2").Value
Do
Selection.Offset(1, 0).Select
ActiveCell.FormulaR1C1 = "=R\[-1\]C+0.01"
Loop Until ActiveCell.Value = "$C$1"
End Sub][1]
P.S. Value in Column A can change
Image
Edit: to help clarify, I'd like to be able to populate B2:B6 through VBA so I can copy paste section A2:B6 down. My problem is that next month I will lose the August section and only have Sep to Dec, and so on as the year goes on.
This is my first time actually asking a question here so sorry in advance if I do something incorrectly. I'm very new to vba and need help getting this code to adjust itself and know when to stop.
My old code is this:
ActiveCell.FormulaR1C1 = "=RC[1]"
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.FormulaR1C1 = "=R[-1]C[2]"
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.FormulaR1C1 = "=R[-2]C[3]"
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.FormulaR1C1 = "=R[-3]C[4]"
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.FormulaR1C1 = "=R[-4]C[5]"
ActiveCell.Offset(1, 0).Range("A1").Select
'ActiveCell.FormulaR1C1 = "=R[-5]C[6]"
'ActiveCell.Offset(1, 0).Range("A1").Select
'ActiveCell.FormulaR1C1 = "=R[-6]C[7]"
'ActiveCell.Offset(1, 0).Range("A1").Select
'ActiveCell.FormulaR1C1 = "=R[-7]C[8]"
'ActiveCell.Offset(1, 0).Range("A1").Select
'ActiveCell.FormulaR1C1 = "=R[-8]C[9]"
'ActiveCell.Offset(1, 0).Range("A1").Select
'ActiveCell.FormulaR1C1 = "=R[-9]C[10]"
'ActiveCell.Offset(1, 0).Range("A1").Select
'ActiveCell.FormulaR1C1 = "=R[-10]C[11]"
'ActiveCell.Offset(1, 0).Range("A1").Select
'ActiveCell.FormulaR1C1 = "=R[-11]C[12]"
'ActiveCell.Offset(1, 0).Range("A1").Select
Where all it does is transpose a year's worth of data into a singular column. I'm trying to end with something like:
If ActiveCell.Offset(0, 1).Value <> "Dec" Then
c As Long
For c = 1 To 12
ActiveCell.FormulaR1C1 = "=RC[&c&]"
ActiveCell.Offset(1, 0).Range("a1").Select
Next c
Where it will adjust the C# and stop after it reaches a certain value in the next column. Currently I just add or remove a ' in front of each pair of the old code to get it to stop where i need it to but i'd like it to be able to do it by itself.
Thanks!
Try this:
Dim rng As Range
Dim last_col As Integer
last_col = Cells(ActiveCell.Row, Columns.Count).End(xlToLeft).Column
If last_col > ActiveCell.Column Then
Set rng = Range(Cells(ActiveCell.Row, ActiveCell.Column), Cells(ActiveCell.Row, last_col))
rng.Copy
ActiveCell.Offset(1, 0).PasteSpecial xlPasteAll, Transpose:=True
Set rng = Nothing
End If
I'm trying to stop using ActiveCell etc as StackOverflow has very much declared this a "nono"
My current code is:
Sub SitesAndProd()
Set wb = ActiveWorkbook
Set ws = Worksheets("Data")
Set rng = ws.Cells(1, 13)
LastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
rng.FormulaR1C1 = "SitesAndProd" 'Rename Cell SitesAndProd
Set rng = ws.Cells(2, 13)
rng.FormulaR1C1 = "=RC[-12]&RC[-4]"
rng.Offset(0, -1).Select 'Move left 1 column
Selection.End(xlDown).Select 'Go to bottom of column
rng.Offset(0, 1).Select 'Move right 1 column
Range(Selection, Selection.End(xlUp)).Select 'Go to top of Column
Selection.FillDown 'Copy Formula Down "Fill"
Selection.Copy 'Ctrl + C
Selection.PasteSpecial xlPasteValues 'Right click + V
Application.CutCopyMode = False 'Esc (stops the crawling ants
End Sub
When using Selection.End(xlDown).Select and xlUp later - it's not saving the range position
What's the best way to make sure the range is kept here?
When using the following:
Range("M2").Select
ActiveCell.FormulaR1C1 = "=RC[-12]&RC[-4]"
Range("M2").Select
ActiveCell.Offset(0, -1).Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Select
Range(Selection, Selection.End(xlUp)).Select
Selection.FillDown
The code will pull the correct form - going left 1, to the bottom, right 1, selecting up to to the, then copying down
Any chance that someone can point me in the right direction to be able to do this without ActiveCell, Selection and Select?
This is supposing the LastRow you calculated on column A equals the same amount of rows in column M
Option Explicit
Sub SitesAndProd()
Dim wb As Workbook, ws As Worksheet, LastRow As Long
Set wb = ThisWorkbook
Set ws = Worksheets("Data")
ws.Cells(1, 13) = "SitesAndProd"
LastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
With ws.Range(ws.Cells(2, 13), ws.Cells(LastRow, 13))
.FormulaR1C1 = "=RC[-12]&RC[-4]"
.Value = .Value
End With
End Sub
I've tweaked some of your code. You need to declare your variables, wb As Workbook and ws As Worksheet. If workbook is the one you got your code in, use ThisWorkbook instead ActiveWorkbook you will get less errors from that.
Edit: Try to avoid as much the global variables. Pass them on your subs or functions as variables.
I expect your code:
Range("M2").Select
ActiveCell.FormulaR1C1 = "=RC[-12]&RC[-4]"
Range("M2").Select
ActiveCell.Offset(0, -1).Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Select
Range(Selection, Selection.End(xlUp)).Select
Selection.FillDown
can be replaced with:
Range(Range("M2"), Range("M" & ActiveSheet.Rows.Count).End(xlUp)).Formula = "=RC[-12]&RC[-4]"
If the column which you would like to use to determine the last filled cell is column Q:
Range(Range("M2"), Range("Q" & ActiveSheet.Rows.Count).End(xlUp).Row).Formula = "=RC[-12]&RC[-4]"
I have a functioning macro that copy pastes the static values of live data from the live data sheet (Sheet), onto a separate sheet (Sheet2) every second. The code is below. For your information, Range("B2:B2195") are stock codes while Range("H2:H2195") are stock quotes.
Sub copypaste_RECENT()
Dim ab As Integer
Worksheets("Sheet").Range("B2:B2195").Copy
With Sheets("Sheet2")
.Range("B1").PasteSpecial Transpose:=True
ab = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Cells(1, 1).Value = "Time"
.Cells(ab, 1).Value = Now
Worksheets("Sheet").Range("H2:H2195").Copy
.Range("B" & ab).PasteSpecial Paste:=xlPasteValues, Transpose:=True
End With
Application.OnTime Now + TimeSerial(0, 0, 1), "copypaste_RECENT"
End Sub
My next step is one that im having trouble with. I would like to record the difference between the stock quotes. This means calculating the difference between a certain cell and the cell above it and recording this difference onto a separate sheet (Sheet3). This would run simultaneously to the code above so I've tried to include an additional code after End With and before the Application. The code is below.
Worksheets("Sheet").Range("B2:B2195").Copy
With Sheets("Sheet3")
.Range("B1").PasteSpecial Transpose:=True
Dim xy As Long, yz As Long
ab = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
bc = .Cells(1, .Columns.Count).End(x1toleft).Column + 1
.Cells(1, 1).Value = "Time"
.Cells(ab, 1).Value = Now
xy = Worksheets("Sheet2").Cells(.Rows.Count, 1).End(x1up).Row
yz = Worksheets("Sheet2").Cells(.Rows.Count, 1).End(x1up).Row.Offset(-1, 0)
For ab = 1 To Cells(Rows.Count, 1).End(x1up).Row + 1
For bc = 1 To Cells(1, Columns.Count).End(x1toleft).Column + 1
.Cells(ab, bc).Value = xy - yz
Next ab
Next bc
End With
I'm quite new to VBA and I know this is completely wrong. I've been struggling for a while but I hope it makes some sort of sense.
Thanks in advance!
Grant
EDIT1: This is a simple computation that calculates the difference between a certain cell and the cell above it and records this value onto a separate sheet. This computation is done for every cell in the range.
I am not comletely cleat what you like to achieve. Is it alog, so you write consecutive lines of copied and computed entries, or is is just some computation. So depending on this you have at least three options:
1) copy/paste with math functions
using the copy/past with the special mathematical functions (add, substract, multiply, divide)
2) formulas
you enter in sheet3 the formuala into B2 =+sheet2!B4-sheet2!B3 which will compute this automatically.
3) compute an store the difference
make a computation as above and copy/paste the result to the final destination.
EDIT
Excel is designed to do computations! So why do you want to redo this?
You can do all of the mentioned solutions as VBA. The same way as you did is with your copy and paste above.
Here is a short makro which shows what I mean.
Sub Makro1()
'
' Makro1 Makro
'
'
ActiveCell.FormulaR1C1 = "Line 1"
Range("B1").Select
ActiveCell.FormulaR1C1 = "8"
Range("C1").Select
ActiveCell.FormulaR1C1 = "5"
Range("D1").Select
ActiveCell.FormulaR1C1 = "6"
Range("E1").Select
ActiveCell.FormulaR1C1 = "4"
Range("F1").Select
ActiveCell.FormulaR1C1 = "6"
Range("G1").Select
ActiveCell.FormulaR1C1 = "3"
Range("A2").Select
ActiveCell.FormulaR1C1 = "12"
Range("A2").Select
ActiveCell.FormulaR1C1 = "Line 2"
Range("B2").Select
ActiveCell.FormulaR1C1 = "15"
Range("C2").Select
ActiveCell.FormulaR1C1 = "456"
Range("D2").Select
ActiveCell.FormulaR1C1 = "23"
Range("E2").Select
ActiveCell.FormulaR1C1 = "42"
Range("F2").Select
ActiveCell.FormulaR1C1 = "45"
Range("G2").Select
ActiveCell.FormulaR1C1 = "77"
Range("A1:G1").Select
Selection.Copy
Range("A5").Select
ActiveSheet.Paste
Range("B2:G2").Select
Application.CutCopyMode = False
Selection.Copy
Range("B5").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlSubtract, _
SkipBlanks:=False, Transpose:=False
End Sub
I have several tables pasted one after another, I am trying to add two extra columns, one for the skill name and one for the date. When i run this code, the columns are added and I can see the pointer going to each cell, but it is not assigning any values. I will appreciate your suggestions on this code.
Dim date_var As String
Dim skill_var As String
Dim msg_var As Integer
Sub Add_Date_Skill()
ThisWorkbook.ActiveSheet.Range("A1").Select
ActiveCell.EntireColumn.Insert
ActiveCell.EntireColumn.Insert
ThisWorkbook.ActiveSheet.Range("C2").Select
Do While Not IsEmpty(ActiveCell.Value)
If ActiveCell.Value = "Date" Then
ActiveCell.Offset(0, 1).Select
Let date_var = ActiveCell.Value
ActiveCell.Offset(0, -1).Select
ElseIf ActiveCell.Value = "Split/Skill" Then
ActiveCell.Offset(0, 1).Select
Let skill_var = ActiveCell.Value
ActiveCell.Offset(0, -1).Select
Else
ActiveCell.Offset(0, -2).Select
ActiveCell.Value = skill_var
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = date_var
ActiveCell.Offset(0, 1).Select
End If
ActiveCell.Offset(1, 0).Select
Loop
End Sub
Solved, the Date and Split/Skills have a Colon (:) at the end!