Sub NSV_LINK()
Dim cell As Range
Dim Rng As Range
Set Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
For Each cell In Rng
If cell.Value = "Hemanta" Then cell.EntireRow.Copy Sheets(2).Cells(1, 1)
Next cell
End Sub
In the code above, I want the macro to copy and paste values in successive rows in sheet 2. However, I have hard coded the destination cell i.e, the value gets pasted at A1. How do I write the cell destination, so that the values get pasted in successive rows? Cells(i, 1)...Something like this. And then i takes a range from, let's say 1 to 20. How do I write this in code?
you need a counter and you have to increment it
Sub NSV_LINK()
Dim cell As Range, Rng As Range, r As Long
Set Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
r = 1
For Each cell In Rng
If cell.Value = "Hemanta" Then
cell.EntireRow.Copy Sheets(2).Cells(r, 1)
r = r + 1
End If
Next cell
End Sub
you can adapt the same technique you already used in Set Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp)) to make destination range dynamic:
Sub NSV_LINK()
Dim cell As Range, Rng As Range
Set Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
For Each cell In Rng
If cell.Value = "Hemanta" Then cell.EntireRow.Copy Sheets(2).Cells(Rows.Count, 1).End(xlUp).Offset(1) ' make destination range dynamic to target sheeet column A first not empty cell after last not empty one
Next cell
End Sub
Related
The code below is used to halve the value in cell A (where the corresponding cell in column B is above 3). Is there any way to also highlight the cell in red (based on the same condition). So, if the corresponding cell in column B is above 3, it is halved AND highlighted Red:
Sub halveandcolorchange()
Dim cell As Range, rng As Range, A As Range, LastRow As Long
LastRow = Cells(Rows.Count, "B").End(xlUp).Row
Set rng = Range("B1:B" & LastRow)
For Each cell In rng
Set A = cell.Offset(0, -1)
If cell.Value > 3 Then A.Value = A.Value / 2
Next cell
End Sub
Please fully qualify your range, Excel will assume that you are referring to the ActiveWorkbook and ActiveSheet which might not be your intention.
E.g. ThisWorkBook.Sheets("Sheet1").Range("B1:B" & LastRow)
Sub halveandcolorchange()
Dim cell As Range, rng As Range, A As Range, LastRow As Long
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Sales")
LastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
Set rng = ws.Range("B1:B" & LastRow)
For Each cell In rng
Set A = cell.Offset(0, -1)
If cell.Value > 3 Then
A.Value = A.Value / 2
A.Interior.ColorIndex = 3
End If
Next cell
End Sub
When i change the value of column H from ESTOQUE to VENDAS i want the respective line (Range C4:G4) to be paste with its current value and no longer the equation that made the values. This table has hudred of cells so a want to do it automatomaticaly for each line i change the cell to "Vendas".
enter image description here
Try this please:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim LastRow As Long
Dim Rng As Range
Dim Rng2 As Range
Dim RowNum As String
Dim Val As String
With Sheets("Sheet1") 'Rename "Sheet1" to your worksheet name
LastRow = .Cells(.Rows.Count, "H").End(xlUp).Row 'find the last row of column H
Set Rng = .Range("H1:H" & LastRow) 'Set the range from H1 to the lastrow number
If Not Application.Intersect(Rng, Range(Target.Address)) Is Nothing Then 'the code will only trigger if you change a cell in column H
Val = Target.Value 'assign the value of the cell changed to the variable Val
RowNum = Target.Row 'assign the row number of the cell changed to the variable RowNum
If Val = "VENDAS" Then 'if the cell value was changed to 'VENDAS' then change from formula to values
Set Rng2 = .Range("C" & RowNum & ":G" & RowNum)
Rng2.Value = Rng2.Value
End If
End If
End With
End Sub
I have a problem. I need to write the macro which select the values in column E.
Values of selected items should be between values in cell T2 and U2.
After selection, macro should draw the chart.
I tried 3 ways:
First Approach:
Sub wykres1()
Dim rng As Range
Dim cell As Range
Set rng = Range("E1", Range("E65536").End(xlUp))
For Each cell In rng
If cell.Value > "T2" and cell.value < "U2" Then Cell.Select
With Selection
ActiveSheet.Shapes.AddChart2
End With
Next cell
End Sub
Wykres1 Doesn't work, because the line with if is highlighted on red.
Second Approach:
Sub wykres2()
Dim rng As Range
Dim cell As Range
Set rng = Range("E1", Range("E65536").End(xlUp))
For Each cell In rng
If cell.Value > ActiveSheet.Cell(2,20).Value and cell.value < ActiveSheet.Cell(2,21).Value Then Cell.Select
With Selection
ActiveSheet.Shapes.AddChart2
End With
Next cell
End Sub
Wykres2 Doesn't work, because the line with if is highlighted on red.
Third Approach:
Sub wykres3()
Dim rng As Range
Dim cell As Range
Set rng = Range("E1", Range("E65536").End(xlUp))
For Each cell In rng
If cell.value > -35 And cell.value < -32 Then cell.Select
With Selection
ActiveSheet.Shapes.AddChart2
End With
Next cell
End Sub
Wykres3 freeze after run. When I remove the part with draw chart, the
macro select one cell not the range with selected values. And here I
put the values in macro (-35) (-32) - but I'm interested in possibility
to put values from cells (T2) (U2).
As I mentioned - I need to create macro which select the cells in column E with values between values in cells T2 and U2. After selection macro must draw the chart.
Thank You for Your help.
Try this (Untested). avoid the use of .Select. Work with objects. You may want to see How to avoid using Select in Excel VBA
Sub wykres1()
Dim rng As Range, cell As Range
Dim lRow As Long, i As Long
Dim ws As Worksheet
'~~> Change as applicable
Set ws = Sheet1
With ws
'~~> Find last row in Col E
lRow = .Range("E" & .Rows.Count).End(xlUp).Row
'~~> Loop though the range
For i = 1 To lRow
If .Range("E" & i).Value > .Range("T2").Value And _
.Range("E" & i).Value < .Range("U2").Value Then
With .Range("E" & i)
'
'~~> Do Something
'
End With
End If
Next i
End With
End Sub
As I mentioned - I need to create macro which select the cells in column E with values between values in cells T2 and U2. After selection macro must draw the chart.
You can store each range found above in one range object and then use that. See this example
Sub wykres1()
Dim rng As Range, cell As Range
Dim lRow As Long, i As Long
Dim ws As Worksheet
Dim Obj As ChartObject
'~~> Change as applicable
Set ws = Sheet1
With ws
'~~> Find last row
lRow = .Range("E" & .Rows.Count).End(xlUp).Row
'~~> Liip though the range
For i = 1 To lRow
If .Range("E" & i).Value > .Range("T2").Value And _
.Range("E" & i).Value < .Range("U2").Value Then
'~~> Store the cell in a range object
If rng Is Nothing Then
Set rng = .Range("E" & i)
Else
Set rng = Union(rng, .Range("E" & i))
End If
End If
Next i
'~~> Once you have the range, create a chart and assign range
If Not rng Is Nothing Then
With .ChartObjects.Add(Left:=100, Width:=375, Top:=75, Height:=225)
.Chart.SetSourceData Source:=rng
.Chart.ChartType = xlColumnClustered
End With
End If
End With
End Sub
so I have two ranges set in two codes. My problem is, the range is specific. No matter how much I changed it, I end up getting an error. My goal is to set the range from C1 all the way until the data stops (same for column J). The range varies depending which spreadsheet I have open so I would like it to detect the end of the data and stop there. Each cell will ALWAYS have data so you don't have to worry about empty cells in between.
Here is my code:
Sub Condition()
Set Rng = Range("C1:C1822")
For Each cell In Rng
If cell.Value <> "SB" Then
cell.Offset(0, 8).Value = "Introduced by Assemblymember"
Else
cell.Offset(0, 8).Value = "Introduced by Senator"
End If
Next
End Sub
'CORRECT LOWER CASE THEN UPPER CASE FIRST LETTER AND OFFSET TO NEW COLUMN
Sub Change()
Dim Rng As Range
Dim c As Range
Set Rng = ActiveSheet.Range("J1:J1822")
For Each c In Rng
c.Offset(, 2).Value = LCase(c.Value)
Next c
For Each cell In Application.ActiveSheet.UsedRange
If (cell.Value <> "") Then
cell.Value = UCase(Left(cell.Value, 1)) & Right(cell.Value, Len(cell.Value) - 1)
End If
Next
End Sub
My problem relies in the beginning at:
Sub Condition()
Set Rng = Range("C1:C1822")
For Each cell In Rng
and later shows up again at:
Sub Change()
Dim Rng As Range
Dim c As Range
Set Rng = ActiveSheet.Range("J1:J1822")
For Each c In Rng
c.Offset(, 2).Value = LCase(c.Value)
Next c
For Each cell In Application.ActiveSheet.UsedRange
If (cell.Value <> "") Then
cell.Value = UCase(Left(cell.Value, 1)) & Right(cell.Value, Len(cell.Value) - 1)
End If
Something like this will adjust to the number of populated rows:
Dim sht as WorkSheet, Rng As Range
Set sht = ActiveSheet
Set Rng = sht.Range(sht.Range("C1"), sht.Cells(sht.Rows.Count,"C").End(xlUp))
I have a spreadsheet that is over 6000 rows and 300 columns. I need to know how to write code in vba that will allow me to read cells in a column and if says "no" then it sets the 3 cells to the right of it equal to zero. There is no error when I debug it, but the error is in the cell.Offset line. Thoughts?
Thank you in advance
Sub Macro1()
Dim rng As Range
Dim cell As Object
With Sheets("Sheet1")
Set rng = .Range("C1:C6000")
For Each cell In rng
If cell.Value = "no" Then
cell.Offset(0, 1).Value = 0
Exit For
End If
Next
End With
End Sub
Borrowing chuff's code:
Sub SetTo0IfNo()
Dim rng As Range
Dim lastRow As Long
Dim cell As Range
With Sheets("Sheet1")
lastRow = .Range("A" & .Rows.Count).End(xlUp).Row
Set rng = .Range("A1:A" & lastRow)
For Each cell In rng
If cell.Value = "no" Then
'cell.Offset(0, 3).Value = 0
cell.Range("B1:D1").Value = 0
End If
Next
End With
End Sub
The following code should do the job. Using a For/Next loop, it reads each of the cells in Sheet 1 from A1 to the last cell in column A that has data. If the current cell has a value of "no", then it sets the value of the cell three columns to the right to the value 0.
Sub SetTo0IfNo()
Dim rng As Range
Dim lastRow As Long
Dim cell As Variant
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
With Sheets("Sheet1")
lastRow = .Range("A" & .Rows.Count).End(xlUp).Row
Set rng = .Range("A1:A" & lastRow)
For Each cell In rng
If cell.Value = "no" Then
cell.Offset(0, 3).Value = 0
End If
Next
End With
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
To set a range of cells to the right of the column A cells to 0, you would use slightly different syntax that still relies on the offset function. For example, to set the three cells immediately to right to 0, replace the above code line cell.Offset(0,3).Value = 0 with the following code.
Range(cell.Offset(0, 1), cell.Offset(0, 3)).Value = 0
This approach is necessary because, unlike the worksheet OFFSET function which can return a reference to a range of cells, the VBA OFFSET can refer only to a single cell.