I need to copy down myValue from input box based on another column count.
Sub CopyDownValue()
Dim MyValue As Variant
Dim LR As String
LR = Range("B" & Rows.Count).End(xlUP)
MyValue = InputBox("Enter Sales Month")
Range("A2").Value = MyValue
End Sub
I need a input box value copied down in column A based on row count in column B.
You left out the .Row in your LR calculation.
You should also qualify your objects (in this instance, ranges) with a worksheet. This is done using the With block, although there are other ways.
Sub CopyDownValue()
Dim MyValue As Variant, LR As Long
With Sheets("Sheet1") '<--- Update with your sheet name
LR = .Range("B" & .Rows.Count).End(xlUp).Row
MyValue = InputBox("Enter Sales Month")
.Range("A2:A" & LR).Value = MyValue
End With
End Sub
Related
wht i want is if cell value in column A is 60 then cell value in the same row in column C must equal FF code below.
Sub column_check2()
Dim c As Range
Dim alastrow As Long
Dim clastrow As Long
alastrow = ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Row
clastrow = ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Row
For Each c In Range("A2:A3" & alastrow & ",C2:C3" & clastrow)
If Not c.Value = "60" And c.Value = "FF" Then
MsgBox "error" & c.Address
End If
Next c
End Sub
You just need to loop through each value in Column A and check your criteria (Cell = 60). You can then adjust the value in Column C by using Offset to navigate 2 cells to the right from the current cell in the loop
Sub Looper()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1") 'Update Sheet Name
Dim lr As Long, Target As Range
lr = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
For Each Target In ws.Range("A2:A" & lr)
If Target = 60 Then
Target.Offset(0, 2) = "FF"
End If
Next Target
End Sub
Even better, consider the way you would likely do this manually. Filter Column A for your target value and then just modify the resultant cells in Column C. Recreating this in VBA results in a solution more efficient than a loop (the larger the data set, the larger the efficiency gains)
Sub Filter()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim lr As Long: lr = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
ws.Range("A1:A" & lr).AutoFilter Field:=1, Criteria1:=60 'Filter
ws.Range("C2:C" & lr).SpecialCells(xlCellTypeVisible).Value = "FF" 'Apply Values
ws.AutoFilterMode = False 'Remove Filter
End Sub
I want to calculate the Average of column Q and place the answer 2 cells below the last value in column Q. The code I'm using performs the calculation and gives me the average of the values between Q2 and the end of column Q if I insert a msgbox but I can't get it to put the answer into the correct cell.
Sub AverageRates()
With ActiveSheet
'Determine last row
Dim lastRow As Long
Dim cellRange As Range
Dim myAvg As Double
lastRow = .Cells(.Rows.Count, "D").End(xlUp).Row
'Average rate calculation
myAvg = Application.WorksheetFunction.Average(Range("Q1:Q" & lastRow))
Range("Q2:Q" & lastRow).Value = myAvg
'place the calculated average value 2 cells below the last cell in column Q
Set cellRange = Range("Q" & Lastrow").offset(2,0).select
End With
End Sub
You were pretty close ... try:
Option Explicit
Sub AverageRates()
Dim lastRow As Long
Dim myAvg As Double
With ActiveSheet
lastRow = .Cells(.Rows.Count, "Q").End(xlUp).Row
myAvg = Application.WorksheetFunction.Average(Range("Q1:Q" & lastRow))
Range("Q" & lastRow).Offset(2, 0).Value = myAvg
End With
End Sub
For a multi-column answer, assuming the columns are not equal in length (if so, then you could use an approach like #BigBen suggests), then you could do something like:
Sub AverageRates2()
Dim mySheet As Worksheet
Dim myColumn As Range
Dim myDataSet As Range
Dim lastRow As Long
Dim myAvg As Double
Set mySheet = ActiveSheet
For Each myColumn In mySheet.Range("J:Q").Columns
lastRow = mySheet.Cells(mySheet.Rows.Count, myColumn.Column).End(xlUp).Row
myAvg = Application.WorksheetFunction.Average(myColumn.Rows(1).Resize(lastRow, 1))
myColumn.Rows(lastRow).Offset(2, 0).Value = myAvg
Next
End Sub
I'm trying to copy values from a range based on a user defined sheet and cell reference. For example in A1 I have defined the Sheet Name to be copied to, B1 is the cell reference to be copied to & C1 is the value to be copied. The below code completes this for row 1 only, but I require to loop this for all rows in a defined range (i.e. named range A1:C200) or until the row is blank.
Preferably I would have an option to copy the cell value in the range (e.g. C1 as above) or the formula that exists in the range.
Sub CopyValues()
Dim SheetName
Dim CellRef
Dim Value
With ThisWorkbook.Sheets("Sheet1")
SheetName = Range("A1").Value
CellRef = Range("B1").Value
Value = Range("C1").Value
End With
ThisWorkbook.Sheets(SheetName).Range(CellRef).Value = Value
End Sub
You were almost there
Sub CopyValues()
Dim SheetName
Dim CellRef
Dim Value
With ThisWorkbook.Sheets("Sheet1")
For i = 1 to 200
SheetName = Range("A" & i).Value
CellRef = Range("B" & i).Value
Value = Range("C" & i).Value
ThisWorkbook.Sheets(SheetName).Range(CellRef).Value = Value
Next i
End With
End Sub
Sub CopyValues()
With ThisWorkbook.WorkSheets("Sheet1")
For Each cell in .Range("A1", .Cells(.Rows.Count, 1).End(xlUp))
ThisWorkbook.Sheets(cell.Value).Range(cell.Offset(,1).Formula = cell.Offset(,2).Formula
Next
End With
End Sub
Thank you both!
I settled on the below which solved my problem.
Sub CopyValues()
Dim SheetName
Dim CellRef
Dim Value
With ThisWorkbook.Sheets("Sheet1")
For i = Range("SheetNameRange").Row To Range("SheetNameRange").Row + Range("SheetNameRange").Rows.Count - 1
SheetName = Range("A" & i).Value
CellRef = Range("B" & i).Value
Value = Range("C" & i).Value
ThisWorkbook.Sheets(SheetName).Range(CellRef).Value = Value
Next i
End With
End Sub
Code below doesnt run. Poorly done over all. Please let me know if you have any questions. Willing to share file.
In a nutshell, what I am trying to do is as follows:
Source Sheet contains the PO forecast by Month. Output sheet is more organized has the same POs but formatted differently. Check screenshot link below before your brain starts hurting. I need to match the Monthly PO (stands for Purchase Order) forecast by month on the Sourcesheet to the POs by month on the output sheet.
If the outputsheet column E contains text "PO labor or PO materials" Then perform Vlookup, otherwise skip. Vlookup matches the PO monthly forecast in the sourcesheet to the output sheet. values must be matched to the month. Loop the if then function until end of outputsheet. After finishing copy and paste any cells in the defined output vlookup range to copy and paste value to reduce multiple coding. at the end you will find screen shots.
Sub NB_Run_Forecast_Upload()
Dim rng1 As Range 'Source Sheet this will set the range in which you want this formula to appear
Dim cl1 As Range
Dim rng2 As Range 'Output Sheet
Dim cl2 As Range 'Output Sheet
Dim rng3 As Range 'Outsheet Range for If Then Statement. Col C must have either "PO Labor" or "PO Materials" to execute Vlookup otherwise skip
Dim strFormula1 as String `string to hold the formula text
Dim SourceLastRow As Long
Dim OutputLastRow As Long
Dim sourceSheet As Worksheet
Dim outputSheet As Worksheet
Dim DataValidation As Worksheet
Set sourceSheet = Worksheets("NB & COAX PO Detail test")
Set outputSheet = Worksheets("New Build & Coax test")
Set DataValidation = Worksheets("Data Validation")
Set rng1 = sourceSheet.Range("I5:AB1339") 'Range hardcoded; need it to go to end
Set rng2 = outputSheet.Range("G1:R5000") 'Range hardcoded; need it to go to the end of rng3
Set rng3 = output.Sheet.Range("C1:C5000") 'Range for If Then statement
'nothing happens in sourceSheet. it is basically, the area where information is stored for vlookup
On Error Resume Next
With sourceSheet 'this might be a double declaration as rng1 does declare
SourceLastRow = .Cells(.Rows.Count, "I").End(xlUp).Row
End With
With outputSheet
'if statement to check if Col C contains either "PO Labor" or "PO Materials"
For Each cl1 In rng2 'my translation: for each cell in rng2 perform the below
If rng3.Value = "PO Materials" Then 'i would prefer to add OR statement to add "PO Labor" reduce redundancy
cl2.Forumla = MyLookupFormula
Else
If rng3.Value = "PO Labor" Then
c2.Forumla = MyLookupFormula
End If
Next rng2 'next col same row until after same row Col R it goes down the row in the outputsheet
End With
Function Colindexnum() As Integer 'i coded the Col number referenec for each month in the Outputsheet that corresponds to the same month in the Sourcesheet
'it's similar to =vlookup(A1, A2:C2, ColIndexNum,0) ColIndexNum changes to each month, its constant in the outputsheet but changes in the sourcesheet
'because every time period a month is deleted. final range is till Dec
Colindexnum = (Application.WorksheetFunction.VLookup(outputSheet.Range("G3:R3"), DataValidation.Range("H30:I41"), 2, False))
End Function
Function MyLookupFormula() As Variant
If Not IsError(Application.WorksheetFunction.VLookup(outputSheet.Range("E:E"), rng1, Colindexnum, False)) Then
MyLookupFormula = (Application.WorksheetFunction.VLookup(outputSheetRange("E:E"), rng1, Colindexnum, False))
Else: MyLookupFormula = vbNullString
End Function
'after each lookup I want to copy and paste the cell it looked up to avoid too much coding Rng2
With outputSheet
For Each rng2 In .UsedRange
If rng2.Formula Like "*VLOOKUP*" Then rng2.Formula = rng2.Value
Next rng2
End With
End Sub
(Output Sheet & Source Sheet Click the next image) http://imgur.com/SHANSLF&ydjQfb3#0
Finally finished this with the help of several genereous memebers of this community and Chandoo. here is the final code that I put together and that actually works.
Sub MakeFormulas()
Dim SourceLastRow As Long
Dim OutputLastRow As Long
Dim sourceSheet As Worksheet
Dim outputSheet As Worksheet
Dim X As Long
Dim Z As Long
'What are the names of our worksheets?
Set sourceSheet = Worksheets("Sheet1")
Set outputSheet = Worksheets("Sheet2")
'Determine last row of source
With sourceSheet
SourceLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
With outputSheet
'Determine last row in col C
OutputLastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
For y = 17 To 28 'Q to AB
For X = 2 To OutputLastRow
If InStr(1, .Range("C" & X), "PO Materials") + InStr(1, .Range("C" & X), "PO Labor") > 0 And Cells(2, y) = "Forecast" Then
'Apply formula
.Cells(X, y).Value = _
Evaluate("=VLOOKUP($E" & X & ",'" & sourceSheet.Name & "'!$A$2:$L$" & SourceLastRow & ",Match(" & Cells(1, y).Address & ",'" & sourceSheet.Name & "'!$A$1:$AD$1,0),0)")
End If
Next
Next
End With
End Sub
Ok, so this is likely the combination of a number of existing questions, but here goes...
I have a requirement to copy data from one sheet to another, then change some data, then add a column to the end with the following:
=if(G2="+",1,0)
This then needs to run down the entirety of the dataset, but the number of rows varies.
Is there a way I can get this formula to appear next to every row that contains data and no further using vba?
Here is an example in which the formula column is column H
Sub qwertyu()
Dim N As Long
N = Cells(Rows.Count, "G").End(xlUp).Row
Dim xCol As String
xCol = "H"
Range(xCol & 2 & ":" & xCol & N).Formula = "=if(G2=""+"",1,0)"
End Sub
Change the column ID to suit your needs.
Yes you can!
Sub ABC()
Dim ws As Worksheet
Dim Lastrow As Long
Set ws = ThisWorkbook.Worksheets("Sheet1") ' change to relevant sheet
With ws
Lastrow = .Range("A" & .Rows.Count).End(xlUp).Row ' change "A" to correct column
.Range("A1:A" & Lastrow).Formula = "=if(G2="+",1,0)" 'change "A1:A" to correct column
' convert formulas to values if you like:
.Range("A1:A" & Lastrow).Value = .Range("A1:A" & Lastrow).Value 'again change "A1:A" to correct column
End With
End Sub