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
Related
Using VBA, I am trying to search for each value in column A of sheet 1, and match it with column A of sheet 2. If a value is found in sheet 2, update column B to "Yes"
Sheet 1
Sheet 2
So far I have:
Sub UpdateStatus()
Dim list() As Variant
Dim item As Integer
'Assign range to a variable
list = Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
'Loop Through Rows
For item = 1 To UBound(list)
'this is where I am stuck
Next item
End Sub
Sheet 2 should look like this afterwards:
Why loop if you can use Excel's engine?
Solution using Excel formulas
Sub Update_Status()
Dim Formula As String
Dim searchRng As Range
Dim valueRng As Range
Dim statusRng As Range
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")
Set valueRng = ws1.Range("A2:A" & LastRow("A", ws1)) ' A2, since you have header
Set searchRng = ws2.Range("A1:A" & LastRow("A", ws2))
Set statusRng = valueRng.Offset(0, 1)
' =IF(COUNTIFS(Sheet2!$A$2:$A$4,Sheet1!A2),"Yes","No")
Formula = "=IF(COUNTIFS(" & _
searchRng.Address(True, True) & "," & _
valueRng.Cells(1, 1).Address(False, False) & _
"),""Yes"",""No"")"
statusRng.Formula = Formula
' In case calculation is turned off
Application.Calculate
' If we prefer hardcoded values
statusRng.Copy
statusRng.PasteSpecial xlPasteValues
Application.CutCopyMode = False ' Flush clipboard
End Sub
Private Function LastRow(Col As String, Ws As Worksheet) As Long
LastRow = Ws.Range(Col & Rows.Count).End(xlUp).Row
End Function
This seems to work:
Sub UpdateStatus()
Dim list() As Variant
Dim item As Integer
Dim FoundCell As Range
Dim SearchValue As String
Dim Sheet2 As Worksheet
Set Sheet2 = Worksheets("Sheet2")
'Assign range to a variable
list = Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
'Loop Through Rows
For item = 1 To UBound(list)
SearchValue = list(item, 1)
Set FoundCell = Sheet2.Range("A2:A6").Find(What:=SearchValue)
If Not FoundCell Is Nothing Then
Sheet2.Range("B" & FoundCell.Row).Value = "Yes"
Else
MsgBox (SearchValue & " not found")
End If
Next item
End Sub
Please help a newbie.
Using Excel VBA, I am trying to format the text in column A with hyphens but only if column B contains the letter B.
I have found the code below, one which formats the cells in column A with hyphens, and another code which checks column B for the correct value, but cannot seem to combine them to work. Help please.
Thank you.
Sub AddDashes()
Dim Cell As Range
On Error GoTo NoFilledCells
For Each Cell In Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row).SpecialCells(xlCellTypeConstants)
Cell.Value = Format(Replace(Cell.Value, "-", ""), "#####-###-####")
Next
NoFilledCells:
End Sub
and
Sub ChangeColumn()
Dim LastRow As Long
Dim i As Long
LastRow = Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow
If Range("B" & i).Value = "B" Then
Range("A" & i).Value = "Formatted text with hyphens as above"
End If
Next i
End Sub
Option Explicit
Sub AddDashes()
Dim ws As Worksheet, cell As Range
Dim LastRow As Long
Set ws = ActiveSheet
LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row
For Each cell In ws.Range("A2:A" & LastRow)
If cell.Offset(0, 1) = "B" Then ' col B
cell.Value = Format(Replace(cell.Value, "-", ""), "#####-###-####")
End If
Next
End Sub
I need to fill down a value in Sheet 1 Cell A2 with =Sheet 2 Cell A2 until the linked value is blank. I dont really know what to do.
I got so far so that I only need zeros in the fields:
Sub Test1()
Dim x As Integer
Dim i As Integer
Dim wsh As Worksheet
Set wsh = Worksheets("List with Weights")
Application.ScreenUpdating = False
i = 2
While (wsh.Cells(i, 1)) <> ""
wsh.Cells(i, 1).FormulaR1C1 = "='Sample Weight'!RC[0]"
wsh.Cells(i, 2).FormulaR1C1 = "='Sample Weight'!RC[0]"
wsh.Cells(i, 3).FormulaR1C1 = "='IS Weight'!RC[-1]"
i = i + 1
Wend
' Selects cell down 1 row from active cell.
ActiveCell.Offset(1, 0).Select
Columns("A:C").Select
Columns("A:C").EntireColumn.AutoFit
Application.ScreenUpdating = True
Range("A1").Select
End Sub
If I have understood you correctly, there is no need for a loop. Is this what you are trying?
Option Explicit
Sub Sample()
Dim wsThis As Worksheet
Dim wsThat As Worksheet
Dim wsOther As Worksheet
'~~> Set your relevant worksheets
Set wsThis = ThisWorkbook.Sheets("List with Weights")
Set wsThat = ThisWorkbook.Sheets("Sample Weight")
Set wsOther = ThisWorkbook.Sheets("IS Weight")
'~~> Find the last row in Col A of Sample Weight worksheet
Dim wsThatLRow As Long
wsThatLRow = wsThat.Range("A" & wsThat.Rows.Count).End(xlUp).Row
'~~> Insert the formula in 1 go in the relevant range
With wsThis
.Range("A2:A" & wsThatLRow).Formula = "='" & wsThat.Name & "'!A2"
.Range("B2:B" & wsThatLRow).Formula = "='" & wsThat.Name & "'!B2"
.Range("C2:C" & wsThatLRow).Formula = "='" & wsOther.Name & "'!B2"
End With
End Sub
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
I Have a Column C that has names in all its cells and another Column E that has the same company name in all its cells I need to append the names in Column C to the company name in column E
Thanks
Ex:
ColC ColE
Bob SampleCo
Sally SamplCo
I get
ColC ColE
Bob SampleCo Bob
Sally SamplCo Sally
I am trying but failing with
Sub CompanyName()
Dim LastRow As Long
Dim Ws As Worksheet
Dim rRange As range
Set rRange = range("E2")
rRange.Select
Set Ws = Sheets("WP_SubjectList_Ready")
LastRow = Ws.range("F" & Ws.Rows.Count).End(xlUp).Row
Ws.range("E2:E" & LastRow).FormulaR1C1 = "=rRange &RC[-1]"
range("E2:E" & LastRow).Copy
range("E2:E" & LastRow).PasteSpecial xlPasteValues
End Sub
Code
Sub CompanyName()
Dim LastRow As Long
Dim Ws As Worksheet
Set Ws = Sheets("WP_SubjectList_Ready")
LastRow = Ws.Range("E" & Ws.Rows.Count).End(xlUp).Row
Ws.Range("F2:F" & LastRow).FormulaR1C1 = "= RC[-1] & "" "" & RC[-3]"
End Sub
If you want the output in Column E its not possible using FormulaR1C1.
Any formula which work for excel interface will work for FormulaR1C1.
With that i mean (considering the image) in cell F2 you can manullay enter a formula = E2 & " " & C2 which will give you desired output. But if you enter in cell E2the formula as =E2 & " " & C2 the cell E2 will loose its value and this may even lead to circular reference issue.
It can be achieved using below code.
Sub CompanyName()
Dim LastRow As Long
Dim Ws As Worksheet
Dim rng As Range, cell As Range
Set Ws = Sheets("WP_SubjectList_Ready")
LastRow = Ws.Range("E" & Ws.Rows.Count).End(xlUp).Row
Set rng = Ws.Range("E2:E" & LastRow)
For Each cell In rng
cell = cell & " " & cell.Offset(0, -2)
Next
End Sub
Here's some code that should help you with what you want...I don't typically use ranges for loops because it's easier to use .Cells(row, col) for me, but anyways:
EDIT: Added Sub Opening/Closing Syntax and edited to use WS instead of ActiveSheet so it's closer to what you want
Sub CompanyName()
Dim WS as Worksheet
Dim vRow
Dim vRowCount As Integer
Set WS = Sheets("WP_SubjectList_Ready")
'Gets Row # of Last Row for Column E
vRowCount = Range("E" & Rows.Count).End(xlUp).row
'Assuming Both Columns have the same row count and you have a header row
For vRow = 2 To vRowCount
WS.Cells(vRow, 5).Value = WS.Cells(vRow, 5).Value & " " & WS.Cells(vRow, 3).Value
Next vRow
End Sub