Okay folks, I have this simple table below and I am trying to calculate a macro vba formula in column G as long as column c has a value. All the info in the spreadsheet is already pulled in from a previous macro. Here is what I have....
Sub Macro1()
'
' Macro1 Macro
'
Dim x As Long
x = CLng((d2 + e2) / c2)
For Each r In Intersect(ActiveSheet.UsedRange, Range("C:C"))
If r.Value <> "" Then
r.Offset(1, 5).Value = x
End If
Next r
End Sub
Try the code below, it will loop through Column C (until last row with value in it), and will calculate your formula with the relevant parameters of that row in Column G.
Note: your formula of (D+E)/C will give you small values, as C has high values. If that's the formula you want to use, than you need to change the output from Long to Double to show the numbers after the 0..
Code
Option Explicit
Sub Macro1()
' Macro1
Dim r As Range
Dim LastRow As Long
' modify "Sheet1" to your sheet's name
With Sheets("Sheet1")
' find last row with data in Column C ("Salary")
LastRow = .Cells(.rows.Count, "C").End(xlUp).Row
For Each r In .Range("C2:C" & LastRow)
If r.Value <> "" Then
r.Offset(0, 4).Value = CDbl((Range("D" & r.Row).Value + Range("E" & r.Row).Value) / r.Value)
End If
Next r
End With
End Sub
Try this:
Range("G2:G" & Range("C" & Rows.Count).End(xlUp).Row).Formula = "=CONCATENATE(C2,"", "",B2)"
Counts rows in column C, if not empty, fills in Concatenation formula that you can change to your formula.
You refer to cells as Range("D2") etc rather than just d2.
Related
I have the below code where in all other columns there is many populated rows, what I need this formula to do in column F is to find the first blank, then place the formula in it and fill it down to the last row.
What is currently happening is I have the range as F26 as this is usually first blank but this could change and I want the code to identify this and also have the formula dynamically know what row it is on, so for example if one month the first blank was in cell F30 the range would find it and the formula would start as E30*G30.
Any help would be greatly appreciated.
Private Sub calc()
Dim lastrow As Long
Dim rng As Range
lastrow = ThisWorkbook.Worksheets("Indiv").Cells(Rows.Count, 1).End(xlUp).Row
Set rng = Range("F26:F" & lastrow)
rng.Formula = "=Round((E26*G26),2)"
End Sub
You need to find the first free row in column F and then bulid your formula with this row:
Option Explicit
Private Sub calc()
Dim ws As Worksheet ' define worksheet
Set ws = ThisWorkbook.Worksheets("Indiv")
Dim LastRowA As Long ' find last used row in column A
LastRowA = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
Dim FirstFreeRowF As Long ' find first free row in column F (if first 2 rows have data)
FirstFreeRowF = ws.Cells(1, "F").End(xlDown).Row + 1
' fix issue if first or second row is empty
If FirstFreeRowF = ws.Rows.Count + 1 Then
If ws.Cells(1, "F").Value = vbNullString Then
FirstFreeRowF = 1
ElseIf ws.Cells(2, "F").Value = vbNullString Then
FirstFreeRowF = 2
End If
End If
' define range to add formula
Dim Rng As Range
Set Rng = ws.Range("F" & FirstFreeRowF, "F" & LastRowA)
' add formula
Rng.Formula = "=Round((E" & FirstFreeRowF & "*G" & FirstFreeRowF & "),2)"
End Sub
So this will consider F5 the first free row and fill in the formula in the selected range as seen below:
I think you should find the last used row in column F, so that you could know the next row is blank
lastrowF=sheets(sheetname).range("F" & rows.count).end(xlup).row
So the next row would be like
range("F" & lastrowF+1).formula="Round((E" & lastrowF+1 & "*G" & lastrowF+1 & ",2)"
i am looking for a solution to my problem. The task is to compare two consecutive rows with each other,in the range from column D1 to the last written cell in Column D. If the value of a consecutive cell is equal to the value of the previous cell , i.e. D2=D1, the macro can go next, else it shall insert a new row between the two values. Since i am fairly new to vba and mostly use information based on online research, i could not find a fitting solution til now. Below you can see a part of what tried.
Sub Macro()
'check rows
Dim a As Long
Dim b As Long, c As Long
a = Cells(Rows.Count, "D").End(xlUp).Row
For b = a To 2 Step -1
c = b - 1
If Cells(b, 4).Value = Cells(c, 4).Value Then
If Cells(b, 4).Value <> Cells(c, 4).Value Then
Rows("c").Select
Selection.Insert Shift:=xlDown
End If
End If
Next b
End Sub
Sub InsertRows()
Dim cl As Range
With ActiveSheet
Set cl = .Cells(.Rows.Count, "D").End(xlUp)
Do Until cl.Row < 2
Set cl = cl.Offset(-1)
If cl.Value <> cl.Offset(1).Value Then cl.Offset(1).EntireRow.Insert
Loop
End With
End Sub
Side note. You can benefit from reading How to avoid using Select in Excel VBA
I have 2 columns A and B
I want to copy the Column A data into Column B. There are few blank cells in A, but those blanks should not overwrite any data in column B. Only the cells which have data should be copied into B.
How can this be achieved in VBA?
This is probably not a complete solution, but might give you some ideas:
Sub test()
Dim R As Range
Set R = Range("A:A").SpecialCells(xlCellTypeConstants, 23)
R.Offset(0, 1).Value = R.Value
End Sub
If the data in column A include computed values, this might not work as intended.
Since you have a conditional paste, you will need to loop here. Check each value in Column A and move the VALUE to Column B (if-and-only-if Column A is not blank)
Sub Jeeped()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim lr As Long, i
lr = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
For i = 2 To lr
If ws.Range("A" & i) <> "" Then
ws.Range("B" & i).Value = ws.Range("A" & i).Value
End If
Next i
End Sub
I'm trying to solve this code's issue, which I can't run:
'========================================================================
' CHECKS IF MARKET SECTOR IS EMPTY (FOR LEDGER)
'========================================================================
Private Sub Fill_MarketSector()
Dim LastRow As Long
Dim rng As Range, C As Range
With Worksheets("Ready to upload") ' <-- here should be the Sheet's name
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row ' last row in column A
Set rng = .Range("A2:A" & LastRow) ' set the dynamic range to be searched
Set rng2 = .Range("F2:F" & LastRow)
' loop through all cells in column A and column F
For Each C In rng and For Each C in rng2
If rng.C.Value = "Ledger" and rng2.C.value IsEmpty Then
C.Value = "599" ' use offset to put the formula on column "L"
End If
Next C
End With
End Sub
The code should check if the column A contains word "Ledger" and column F is empty, then it should put into column F "599". It should always check to the very last row. Could you help me, please?
Thanks a lot!
You can access the accompanying cells in column F by looping through the cells in column A and using .Offset for column F then offset again to put the value in column L.
' loop through all cells in column A and column F
For Each C In rng
If LCase(C.Value) = "ledger" and IsEmpty(C.Offset(0, 5) Then
C.Offset(0, 11) = 599 'use offset to put the number on column "L"
End If
Next C
I need to write a macro that compares the date in B1 with the date in columns D1.DB1. If they match, the column that matches needs to be copied and paste values. This is what I have done so far. But it is not working.
Sub MyCopyPasteValues()
' CopyPasteValus Macro
' Macro to hard code last weeks data.
Dim i As Integer
Sheets("data").Range("B1").Select
For i = 4 To 56
If Worksheets("Data").Cells(1, i).Value = "B1" Then
Range(1, i).Select
ActiveCell.EntireColumn.Select
Selection.Copy
ActiveSheet.PasteSpecial xlPasteValues
End If
Next i
End Sub
Okay, so first of all: avoid using .Select method, it is very risky and can harm your data.
You do not need to select cell if you want to do something with it. Also if you want to compare one cell value with another, you should use Range() or Cells(). You used "B1" which means you were checking for value B1 not for value of Cell B1.
Edit:
Not sure if this is what you want so lets give it a try. y represents row number and i represents column number. For each y there will checked all cells in columns i. They will be checked with a date in row y in column B.
Sub MyCopyPasteValues()
' CopyPasteValus Macro
' Macro to hard code last weeks data.
Dim i As Byte, ws As Worksheet
Set ws = Worksheets("Data")
For y = 3 To 73
For i = 4 To 56
If ws.Cells(y, i).Value = ws.Range("B" & y).Value Then
ws.Cells(y, i).Value = ws.Cells(y, i).Value
End If
Next i
Next y
End Sub
Sub MyCopyPasteValues()
' CopyPasteValus Macro
' Macro to hard code last weeks data.
Dim i As Byte, ws As Worksheet
Set ws = Worksheets("Data")
For y = 3 To 73
For i = 4 To 56
If ws.Cells(1, i).Value = ws.Range("B" & 1).Value Then
ws.Cells(y, i).Value = ws.Cells(y, i).Value
End If
Next i
Next y
End Sub