Mathematical equation in vba - vba

I have mathematical equation which I am performing in sheet "Accrued Expenses" on Range("E7"). The formula is intend to loop till the lastrow in column C The two key sheets are "Start page" and "Accrued Expenses" .
The problem is that I am not able to get into VBA code. It works using the Excel macro recorder, but it wont be efficient for maintenance. My equation and code below.
=('Accrued Expenses'!C7*'Start page'!$F$5)/'Start page'!$F$13*'Accrued Expenses'!D7
In Excel recorder code and with a loop:
Option Explicit
Sub Calculating_Accruedexpense()
Sheets("Accrued Expenses").Select
Dim LastRow As Long
LastRow = ActiveSheet.Range("C" & Rows.Count).End(xlUp).row
Range("E7").Select
Do Until ActiveCell.row = LastRow + 1
If IsEmpty(ActiveCell) Then
ActiveCell.FormulaR1C1 = _
"=('Accrued Expenses'!RC[-2]*'Start page'!R5C6)/'Start page'!R13C6*'Accrued Expenses'!RC[-1]"
End If
ActiveCell.Offset(1, 0).Select
Loop
End Sub
Excel Recorder line:
ActiveCell.FormulaR1C1 = _
"=('Accrued Expenses'!RC[-2]*'Start page'!R5C6)/'Start page'!R13C6*'Accrued Expenses'!RC[-1]"

Try this:
Sub Calculating_AccruedExpense()
Dim lastRow As Long, cl As Range
lastRow = Worksheets("Accrued Expenses").Range("C" & Rows.Count).End(xlUp).Row
For Each cl In Range("E7:E" & lastRow)
If IsEmpty(cl) Then
cl = (cl.Offset(0, -1) * Worksheets("Start page").Range("F5")) / Worksheets("Start page").Range("F13") * cl.Offset(0, -2)
End If
Next cl
End Sub

Related

How to have sum formula VBA for a specific row on each sheet?

Hello so a part of my macro is going through each sheet and putting the sum of that column at the end of it on each of the sheets. But currently it is printing the sum as is, I also want it to show the formula.
Sub GoNext()
Dim i As Integer
For Each ws In ThisWorkbook.Worksheets
Columns("E:E").Select
Selection.NumberFormat = "$#,##0.00"
i = ActiveSheet.Index + 1
If i > Sheets.Count Then i = 1
Sheets(i).Activate
If ActiveSheet.Name <> "CPOA Report Macro" Then
If ActiveSheet.Name <> "Summary" Then
LastRow = Cells(Cells.Rows.Count, "E").End(xlUp).Row + 1
Range("E" & LastRow).Font.Bold = True
Range("E" & LastRow) = WorksheetFunction.Sum(Range("E2:E" & LastRow - 1))
End If
End If
Next ws
End Sub
I suggest to avoid using .Select and .Activate: See How to avoid using Select in Excel VBA. You can access the sheets and ranges directly.
Also your If statements can be combined by using And.
And you can use .Formula to set the formula for a cell.
Option Explicit
Public Sub GoNext()
Dim LastRow As Long
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
ws.Columns("E").NumberFormat = "$#,##0.00"
If ws.Name <> "CPOA Report Macro" And ws.Name <> "Summary" Then
LastRow = ws.Cells(ws.Rows.Count, "E").End(xlUp).Row + 1
ws.Range("E" & LastRow).Font.Bold = True
ws.Range("E" & LastRow).Formula = "=SUM(E2:E" & LastRow - 1 & ")"
End If
Next ws
End Sub
I recommend to use meaningful procedure names like Sub SetFormatAndSumFormula or something like this. That makes your code much easier to read.

VBA Formula w/ Relative Reference

I'm running into an issue using the following VBA formula. The code was working until I changed
IFERROR(IF(VLOOKUP(RC1,ListPrice,11,FALSE)=0,VLOOKUP(RC1,ListPrice,12,FALSE),VLOOKUP(RC1,ListPrice,11,FALSE)),0)*RC6
to
iferror(IF(RC11="",RC12,RC11),0)*(RC6/IF(RC8="",1,RC8)
Thanks for your help!
Complete VBA:
Sub STDCOST()
Dim LastRow As Long
Sheets("EXPIRE").Select
Range("n1").Value = "Ext_Cost"
Range("n2").FormulaR1C1 = "=IFERROR(IF(RC11="",RC12,RC11),0)*(RC6/IF(RC8="",1,RC8)"
Range("I1").Select
With ActiveSheet
LastRow = .Cells(.Rows.Count, "I").End(xlUp).Row
End With
Range("n2").AutoFill Destination:=Range("n2:n" & LastRow)
Columns("n:n").Select
Range("n:n").Style = "Currency"
End Sub

Selecting certain columns in VBA after searching

I am trying to search for text on a sheet in column c then if found within the same row select column a and copy and paste to sheet two. i have started with this code
Sub Test()
For Each Cell In Sheets("Asset Capture").Range("C35:C3000")
If Cell.Value = "MONITOR" Then
matchRow = Cell.Row
Rows.Range(matchRow & ":" & matchRow).Select
Selection.Copy
Sheets("GRN Status Report").Select
lastRow = ActiveSheet.UsedRange.Rows.Count
If lastRow > 1 Then lastRow = lastRow + 1
ActiveSheet.Range("A" & lastRow).Select
ActiveSheet.Paste
Sheets("Asset Capture").Select
End If
Next
End Sub
but it is selecting the whole row and i can not figure out how to change the code to select data from just the A column?
Try this:
Sub Test()
Dim Cell As Range, rngDest As Range
Set rngDest = Sheets("Grn Status Report").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
For Each Cell In Sheets("Asset Capture").Range("C35:C3000")
If Cell.Value = "MONITOR" Then
Cell.EntireRow.Cells(1).Copy rngDest
Set rngDest = rngDest.Offset(1, 0)
End If
Next
End Sub
Note you don't need to use Select/Activate, and your code will be more robust if you avoid it as much as possible.
See: How to avoid using Select in Excel VBA macros
Hope you looking for this
Sub Test()
increment = Worksheets("GRN Status Report").Range("A" & Rows.Count).End(xlUp).Row
For Each cell In Sheets("Asset Capture").Range("C5:C3000")
If cell.Value = "MONITOR" Then
matchrow = cell.Row
matchcontent = Range("A" & matchrow).Value
Worksheets("GRN Status Report").Cells(increment, 1) = matchcontent
increment = increment + 1
End If
Next
End Sub

Yet another Excel VBA 404 error

I want this script to check the cells on column A if there is a URL-link in them, and if it is true then perform some cut-paste operations.
String #5 returns error 404, please help to solve this!
Sub xxxxxx()
Worksheets("1 (2)").Activate
For i = 1 To 2200
Range("A" & i).Select
If (cell.Range("A1").Hyperlinks.Count >= 1) Then
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.Cut
ActiveCell.Offset(-1, 2).Range("A1").Select
ActiveSheet.Paste
End If
Next i
End Sub
Per #Siddharth Rout post about not using Activate/Select, I've rewritten your code below. No need to check hyperlinks inside the loop every time since it's always checking cell A1
Sub xxxxxx()
Dim ws As Worksheet
Set ws = Worksheets("1 (2)")
Dim LastRow As Long
LastRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
If (ws.Range("A1").Hyperlinks.Count > 0) Then
For i = 2 To LastRow
Range("A" & i).Offset(-1, 2).Value = Range("A" & i).Value
Range("A" & i).Clear
Next i
End If
End Sub

AutoFill Macro to Length

I am trying to Fill a formula that I have in D1 and fill down D to the length of C. I am using the follwing macro and I am getting the following error - Compile Error: Expected end with
Sub Macro3()
Macro3 Macro
Range("D1").Select
ActiveCell.FormulaR1C1 = "=RC[-2]*(-1)+RC[-1]"
Range("D1").Select
Dim LastRow As Long
With Sheets("Sheet2")
LastRow = Range("C" & Rows.Count).End(xlUp).Row
Range("D1").AutoFill Destination:=Range("D2:D" & LastRow)
End Sub
Your problem was a simple one. I used the macro recorder to AutoFill a Formula Range and found that the Destination Range starts with the Formula Range, so
Range("D1").AutoFill Destination:=Range("D2:D" & LastRow)
Should be:
Range("D1").AutoFill Destination:=Range("D1:D" & LastRow)
Here is working code, both fixed and cleaned up a bit :)
Sub Macro3()
With Sheets("Sheet1")
Dim LastRow As Long
LastRow = Range("C" & Rows.Count).End(xlUp).Row
With Range("D1")
.FormulaR1C1 = "=RC[-2]*(-1)+RC[-1]"
.AutoFill Destination:=Range("D1:D" & LastRow)
End With
End With
End Sub