I want to change rows 2 to 10 in column 4 to 10 but it does not work.
Restriction: d As Single must not be changed
Sub ua()
Dim d As Single
Dim i As Integer
d = Cells(i, 4)
For i = 2 To 10
d = 10
Next i
End Sub
Looping through the rows and columns is one option:
Sub TestMe()
Dim myRow As Long, myCol As Long
Dim d As Single: d = 10
For myRow = 2 To 10
For myCol = 4 To 10
Worksheets(1).Cells(myRow, myCol) = d
Next myCol
Next myRow
End Sub
Another one is using the single line solution of #Jeep from the comments -
With Workheets(1)
.Range(.Cells(2, 4), .Cells(10, 10)) = 10
end with
Change Sheet name and try:
Sub test()
With Sheet1
.Range(.Cells(2, 4), .Cells(10, 10)).Value = 10
End With
End Sub
You actually doing nothing with your code (you just set a variable and then you loop without any restult on cell values). If you want to change a value in a cell you have to write this in your code. You can change a value in a cell like this:
Cells(3, 2).Value = 2
If you want this variable and in a loop you can write the following:
For i = 2 to 10
Cells(3, i).Value = 1000 'Set the value of the cell to 1000
Next i
Related
I am trying to number column A in increments by 1, based on how many rows are in column B Example of my Excel sheet
The code I currently have does this, but the top number does not end up being 1. I need to start with 1 at the top and count down.
Sub SecondsNumbering()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Data Formatted")
Dim LastRow As Long
Dim i As Long
With ws
LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
For i = 6 To LastRow
.Cells(i, 1).Value = i - 1
Next
End With
End Sub
With this, I am counting the number of rows in the column.
Edit: When I do the value 7 for i, so that it starts at 6 (which is where I want data to start) this is what I get.
How about...
Option Explicit
Sub Test()
Dim lCntr As Long
lCntr = 6
Do
If (Cells(lCntr, 2) <> "") Then Cells(lCntr, 1) = lCntr - 5
lCntr = lCntr + 1
Loop Until Cells(lCntr, 2) = ""
End Sub
HTH
I want to copy gray cells to rows but only last column gray cell copied.
There's no need for nested loops
Sub Test()
Dim r As Integer, c As Integer
r = 3
For c = 3 To 21 Step 3
Cells(r, 1) = Cells(1, c)
r = r + 1
Next c
End Sub
You are so close :)
Option Explicit
Sub istebu()
Dim x As Long
Dim i As Long
For i = 3 To 10 'Loop in row from 3 to 10
For x = 3 To 21 Step 3 'Loop header row, from 3 to 21, jump 3
Cells(i, 1) = Cells(1, x) 'Copy values.
i = i + 1 'Add one row each time, so we don't overwrite previously row
Next x
Next i
End Sub
Alternative:
It could be shortened as we don't need to loop through the rows. We only need to add them. So we set i to the start row where we should paste our data.
Sub istebu()
Dim x As Long
Dim i As Long
i = 3 'Set first row number you want to loop from.
For x = 3 To 21 Step 3 'Loop header row, from 3 to 21, jump 3
Cells(i, 1) = Cells(1, x) 'Copy values.
i = i + 1 'Add one row each time, so we don't overwrite previously row
Next x
End Sub
There is an alternative to loops altogether.
Range("C1,F1,I1,L1,O1,R1,U1").Copy
Range("A3").PasteSpecial Paste:=xlPasteValues, Transpose:=True
But if you're really into loops, use one to build a union.
dim i as long, rng as range
for 3 to 21 step 3
if rng is nothing then
set rng = cells(1, i)
else
set rng = union(rng, cells(1, i))
end if
next i
rng.Copy
Range("A3").PasteSpecial Paste:=xlPasteValues, Transpose:=True
Gettin a "Type Mismatch" error.
Trying to take one matrix of numbers on one worksheet "Sheet1", divide by another matrix of numbers on a second worksheet "Sheet2", then show each cell result on a matrix on the third worksheet "Sheet1"
Sub MacroTest()
Worksheets("Sheet3").Range("C5") = Worksheets("Sheet1").Range("C5:DR124") / Worksheets("Sheet2").Range("C5:DR124")
End Sub
With this code you can do what you need on specific range (that you can choose) on different sheet and also on the same sheet.
Sub RangeDiv()
Dim RngFrom As Range
Dim RngDiv As Range
Dim RngTo As Range
Dim R As Integer
Dim C As Integer
Set RngFrom = Sheets(1).Range("A1:E3")
Set RngDiv = Sheets(1).Range("B6:F8")
Set RngTo = Sheets(1).Range("C10:G12")
'Check if all Rngs have the same number of rows and columns
If RngFrom.Rows.Count <> RngDiv.Rows.Count Or RngFrom.Rows.Count <> RngTo.Rows.Count Then
MsgBox ("Rngs rows number aren't equal")
Exit Sub
End If
If RngFrom.Columns.Count <> RngDiv.Columns.Count Or RngFrom.Columns.Count <> RngTo.Columns.Count Then
MsgBox ("Rngs columns number aren't equal")
Exit Sub
End If
For C = 1 To RngFrom.Columns.Count
For R = 1 To RngFrom.Rows.Count
'check cell value to avoid errors coming from dividing by 0
If Val(RngDiv.Cells(R, C)) <> 0 Then
RngTo.Cells(R, C) = RngFrom.Cells(R, C) / RngDiv.Cells(R, C)
Else
'Insert something when division is impossible
RngTo.Cells(R, C) = 0 'Or what you want to insert
End If
Next R
Next C
End Sub
I create sheet1 like this
Please click to see Image
then sheet2
Please click to see Image2
then create blank sheet 3
and use this code
Sub divideRange()
Dim lastRow, lastColumn As Long
lastColumn = Sheets("Sheet1").Cells(1, Columns.Count).End(xlToLeft).Column
lastRow = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To lastRow
For j = 1 To lastColumn
Sheets("Sheet3").Cells(i, j).Value = Sheets("Sheet1").Cells(i, j).Value / Sheets("Sheet2").Cells(i, j).Value
Next j
Next i
End Sub
Is this what you want?
Sorry for my late reply.
You can solve your problem with a for-loop:
For i = 3 To 9
If IsNumeric(Worksheets("Tabelle2").Cells(5, i).Value) And IsNumeric(Worksheets("Tabelle3").Cells(5, i).Value) And Worksheets("Tabelle3").Cells(5, i).Value <> 0 Then
Worksheets("Tabelle1").Cells(5, i).Value = Worksheets("Tabelle2").Cells(5, i).Value / Worksheets("Tabelle3").Cells(5, i).Value
End If
Next
variable i is your column as a number. A = 1, B = 2, Z = 26, AA = 27 and so on..
number 5 is your row
For example
Cells(5,1) is the same like Range("A5") or Cells(3,9) = Range("I3")
In my code above, it starts with column C (3) and stops with column I (9). Replace the Number 9 with the number of the Column FX (your last column) and edit the table Names then it should work.
I have this table:
A B C
4 4 X
4 1
4 0 X
4 8
4 4
4 9 X
I need to find matching cells in the row from columns A and B and then cut that matching row and paste it below the table. The range of data is A2:C8.
In my table there are 2 matches, so the result should look like this:
4 4 X
4 4
Here is my code:
Sub cutter()
Dim cell1 As Integer, cell2 As Integer
cell1 = Range("A2").Value
cell2 = Range("B2").Value
If cell1 = cell2 Then
Sheet1.Range("A2:C2").Cut Sheet1.Range("A27:C27")
End If
End Sub
It works fine but I need to compare every row.
I know that I should implement loop like here:
Dim rng As Range
Dim row As Range
Dim cell As Range
Set rng = Range("A2:C8")
For Each row In rng.Rows
For Each cell In row.Cells
' condition
Next cell
Next row
But I don't know how :(
Help anyone?
Thanks in advance!
This code loops until the first empty row in A:
Sub testcompare()
i = 1 'start in cell 1
j = 27 'cut start in cell 27
While Not IsEmpty(Cells(i, 1))
If Cells(i, 1).Value = Cells(i, 2).Value Then
Range(Cells(i, 1), Cells(i, 3)).Cut Range(Cells(j, 1), Cells(j, 3))
i = i + 1
j = j + 1
Else
i = i + 1
End If
Wend
End Sub
I want to delete all rows in excel sheet if specific column value starts with 1.
For example, if range of A1:A having values starts with 1 then I want to delete all those rows using excel vba.
How to get it?
Dim c As Range
Dim SrchRng
Set SrchRng = Sheets("Output").UsedRange
Do
Set c = SrchRng.Find("For Men", LookIn:=xlValues)
If Not c Is Nothing Then c.EntireRow.Delete
Loop While Not c Is Nothing
Here's the required code with comments on how it works. Feed the worksheet and column number to the sub and call it e.g. Delete Rows 2, Sheets("myWorksheet"):
Sub DeleteRows(columnNumber as Integer, ws as WorkSheet)
Dim x as long, lastRow as Long
' get the last used row
lastRow = ws.cells(1000000, columnNumber).end(xlUp).Row
'loop backwards from the last row and delete applicable rows
For x = lastRow to 1 Step -1
' if the cell starts with a number...
If IsNumeric(Left(ws.Cells(x, columnNumber), 1) Then
'Delete it the row if it's equaal to 1
If Left(ws.Cells(x, columnNumber), 1) = 1 Then ws.Rows(x &":"& x).Delete
End If
Next x
End Sub
Dim Value As String
Dim CellName As String
Dim RowNumber As Long
Do While Value <> ""
CellName = "A" + RowNumber
Value = ActiveSheet.Cells(GetRowNumber(CellName), GetColumnNumber(CellName)).Value
If Mid(Value, 1, 1) = "2" Then
ActiveSheet.Range("A" & RowNumber).EntireRow.Delete
End If
RowNumber = RowNumber + 1
Loop
Private Function GetColumnNumber(ByVal CellName As String) As Long
For L = 1 To 26
If Left(CellName, 1) = Chr(L + 64) Then
GetColumnNumber = L
Exit For
End If
Next
End Function
Private Function GetRowNumber(ByVal CellName As String) As Long
GetRowNumber = CLng(Mid(CellName, 2))
End Function
You may be pushing the bounds of what is reasonable to do in Excel vba.
Consider importing the Excel file into Microsoft Access.
Then, you can write 2 Delete Queries and they will run uber fast:
DELETE FROM MyTable WHERE col1 like '2*'
DELETE FROM MyTable WHERE col2 LIKE '*for men*' OR col3 LIKE '*for men*'
After deleting those records, you can export the data to a new Excel file.
Also, you can write an Access Macro to import the Excel File, run the Delete Queries, and Export the data back to Excel.
And you can do all of this without writing a line of VBA Code.
You can try:
Sub delete()
tamano = Range("J2") ' Value into J2
ifrom = 7 ' where you want to delete
'Borramos las celdas
'Delete column A , B and C
For i = ifrom To tamano
Range("A" & i).Value = ""
Range("B" & i).Value = ""
Range("C" & i).Value = ""
Next i
End Sub