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
Related
I am working on a dynamic worksheet which the total rows and columns of content will be changing.
What I try to do is, making an active cell going through the worksheet. It starts from the very last column that has content (I used UsedRange here), and from the 7st row down to the last row not blank.
When 1) The active cell has a color filling of index 16 or 36; 2) The active cell has no value, the cell will fetch the value storing in the matching row E.
The loop will end when hitting column E (I haven't been able to go that far yet).
I will attach my code below for all possible help, since it complies but does not return any result...Thank you again!
Sub catchCurrentAutomated()
Dim column As Integer
Dim row As Integer
Dim Cell As Range
row = 7
column = ActiveSheet.UsedRange.Columns.Count
Set Cell = ActiveCell
While range("A" & row) <> ""
If Cell.Interior.ColorIndex = 16 And _
IsEmpty(Cell.Value) = True Then
Cell.Value = Cells(ActiveCell.row, "E").Value
ElseIf Cell.Interior.ColorIndex = 36 And _
IsEmpty(Cell.Value) = True Then
Cell.Value = Cells(ActiveCell.row, "E").Value
End If
row = row + 1
column = column - 1
Wend
End Sub
Something like this should work (untested)
Sub catchCurrentAutomated()
Dim col As Long '<< use Long not Integer
Dim row As Long
Dim c As Range, ws As Worksheet, lr As Long, indx
Set ws = ActiveSheet
col = ws.UsedRange.Columns.Count
lr = ws.Cells(Rows.Count, 1).End(xlUp).row 'last occupied cell in ColA
Do While col > 5
For row = 7 To lr
With ws.Cells(row, col)
indx = .Interior.Color.Index
If (indx = 16 Or indx = 36) And Len(.Value) = 0 Then
.Value = ws.Cells(row, "E").Value
End If
End With
Next row
col = col - 1 'next column to left
Loop
End Sub
I've a data set that looks similar to the below.
I'd like to average the data in the rightmost column only.
My range starts at C4 with no set end to either rows or columns.
**1**
1 **2**
1 2 **3**
1 **2**
**1**
I've put the following together which does what I need it to do for a single fixed column but I don't know how to expand that out to always use the value from the right most column.
Dim Sum, Count As Integer
Count = 0
Sum = 0
Application.ScreenUpdating = False
Range("C4").Select
Do While ActiveCell.Value <> ""
Sum = Sum + ActiveCell.Value
Count = Count + 1
ActiveCell.Offset(1, 0).Activate
Loop
Range("O1").Value = Sum / Count
Thank you.
This will cycle the rows.
The MATCH will return the column number of the last column with a number in it.
Then we get the number on that row in that column and add it to an array.
Then after the loop we average the array.
Sub aver()
With Worksheets("Sheet4") 'Change to your sheet
Dim lastrw As Long
lastrw = .Cells(.Rows.Count, 3).End(xlUp).Row
Dim num() As Variant
ReDim num(1 To lastrw) As Variant
Dim i As Long
For i = 4 To lastrw
Dim j As Long
j = Application.Match(1E+99, Rows(i), 1)
num(i) = .Cells(i, j).Value
Next i
.Range("O1").Value = Application.Average(num)
End With
End Sub
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
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
Goal: I want to build 4 different strings with method Contagenation. I have a dynamic count of columns (column 4 to maxCol) in each of 4 rows (row 32 to row 35) in sheet ("Calc"). The 4 different strings should be stored in another sheet ("CreateColumns")in cells (A1, A2, A3, A4)
Problem: I have coded the following code to achieve that goal but in sheet ("CreateColumns") each of the 4 rows are filled with the same value = last value of row 35 in sheet("Calc") and not with the 4 different values as intended.
Question: What is the error in my code?
Sub CreateColumns()
Dim maxCol As Integer
Dim x As String
Dim rng As Range
Dim cel As Range
Dim i As Long
Dim row As Long
Dim y As Long
Sheets("Calc").Select
maxCol = Cells(32, columns.Count).End(xlToLeft).column
For row = 32 To 35
Sheets("Calc").Select
Cells(row, 4).Activate
For i = 4 To maxCol
With Worksheets("Calc")
Set rng = Range(.Cells(row, 4), .Cells(row, maxCol))
End With
x = ""
For Each cel In rng
x = x & cel.Value
For y = 1 To 4
Sheets("ColCreate").Cells(y, 1).Value = x
Next
Next
Next
Next
End Sub
The issue in your code is that the part where you paste to sheet "ColCreate" is a bit out of place - it should occur once for each occurence of your outermost loop, alongside the "y" increment
I have slightly amended your code below, should provide the expected result
Sub CreateColumns()
Dim maxCol As Integer
Dim x As String
Dim rng As Range
Dim cel As Range
Dim i As Long
Dim row As Long
Dim y As Long
Sheets("Calc").Select
maxCol = Cells(32, Columns.count).End(xlToLeft).Column
y = 1
For row = 32 To 35
Sheets("Calc").Select
Cells(row, 4).Activate
For i = 4 To maxCol
With Worksheets("Calc")
Set rng = Range(.Cells(row, 4), .Cells(row, maxCol))
End With
x = ""
For Each cel In rng
x = x & cel.Value
Next
Next
Sheets("ColCreate").Cells(y, 1).Value = x
y = y + 1
Next
End Sub