I've got a sheet set up to get the contents of the last row. I want to check the values on that last row from J to W. I want to check if all the values are "YES" and if so return an OK into a variable. Here is what I have so far, it should be clear from the below what I am trying to do:
lastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
sName = ActiveSheet.Name
For Each c In Worksheets(sName).Range(Cells(J, lastRow), Cells(W, lastRow))
If c.Value = "YES" Then
vData = "OK"
Else
vData = "Error."
End If
Next c
Thanks.
Cells(x,y) takes two integers as arguments, and it's row, column not column, row!
Try
For Each c In Sheets(sName).Range(Cells(lastRow, 10), Cells(lastRow, 23))
Dim lRow As Long
Dim lCol As Long
Dim ws As Excel.Worksheet
Set ws = Application.ActiveSheet
lRow = ws.UsedRange.Rows.count
lCol = 10
Do While lCol <= 21
If ws.Cells(lRow, lCol).Value <> "YES" Then
vData = "Error."
Exit Sub
End If
lCol = lCol + 1
Loop
Try this one:
Public Sub checking()
Dim lastRow As Long
'Here, I take row count by using column "J"
'You can modify it if you need
lastRow = Sheets("sheetname").Range("J" & Rows.Count).End(xlUp).row
For Each cell In Sheets("sheetname").Range("J" & lastRow & ":W" & lastRow)
If cell.Value = "YES" Then
vData = "OK"
Else
vData = "Error."
Exit For
End If
Next cell
'Show result
MsgBox vData
End Sub
Related
Dim WB As Workbook
Set WB = ThisWorkbook
Dim lrow As Long
lrow = WB.Sheets("Updated Sheet").Range("B" & Rows.Count).End(xlUp).row
Dim myrange As Range
Set myrange = WB.Sheets("Updated Sheet").Range("R2:R" & lrow)
Dim row As Long
Dim col As Long
row = WB.Sheets("Updated Sheet").Range("AJ2").row
col = WB.Sheets("Updated Sheet").Range("AJ2").Column
For Each cl In myrange 'myrange is basically column "R"
If wb.Sheets("Updated Sheet").Cells(row, col) = "Paid" Then
cl.value = "Paid"
Else
End If
row = row + 1
Next cl
This is the code I currently have for an if statement where I want to replace the value in column R with the string "Paid" if the value in (row, col) is "Paid" as well.
However, the function currently replaces all values in column R even if there is only one "Paid" match, even though running through with f8/adding a msgbox line shows that the value in cell(row, col) is not "paid" for every line.
How should I go about fixing this?
Try Autofilter instead of looping through cells.
Please give this a try...
Sub David()
Dim WB As Workbook
Dim WS As Worksheet
Dim lrow As Long
Set WB = ThisWorkbook
Set WS = WB.Sheets("Updated Sheet")
WS.AutoFilterMode = False
lrow = WB.Sheets("Updated Sheet").Range("B" & Rows.Count).End(xlUp).row
With WS.Range("AJ1:AJ" & lrow)
.AutoFilter field:=1, Criteria1:="Paid"
If WS.Range("R1:R" & lrow).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
WS.Range("R2:R" & lrow).SpecialCells(xlCellTypeVisible).Value = "Paid"
End If
.AutoFilter
End With
End Sub
Add .value to your cell reference. Currrently you are comparing a string with a cell object. That could lead to strange results.
If wb.Sheets("Updated Sheet").Cells(row, col).value = "Paid" Then
Im trying to write a macro that filters the column F from second to last row to check if the values in the column are numeric and if the length is 5. A diffrent length is allowed if the value in the column G on the same row contains "TEST".If the value doesnt meet the criteria the row should be deleted. The macro seems to work but I need to start it multiple times to filter all the values.
here is the macro:
Sub Makro1()
Dim lrow As Long
lrow = Cells(Cells.Rows.Count, "F").End(xlUp).Row
Dim Rng As Range
Set Rng = Range("F2:F" & lrow)
For Each cell In Rng
If Not IsNumeric(cell) Or (Len(cell) <> 5 And
InStr(UCase(cell.Offset(0, 1).Value), "TEST") = 0) Then
cell.EntireRow.Delete
End If
Next
End Sub
Try this code, it uses backward loop, which is recommended when iterating over colletion, that we delete from:
Sub Makro1()
Dim lrow As Long, i As Long, cellValue As String
lrow = Cells(Rows.Count, "F").End(xlUp).Row
For i = lrow To 2 Step -1
cellValue = Cells(i, "F").Value
If Not (IsNumeric(cellValue) And Len(cellValue) = 5) And Cells(i, "G").Value = "TEST" Then
Rows(i).Delete
End If
Next
End Sub
I'm trying to make a macro that will scroll through a spreadsheet an entire row at a time and merge all cells in the active row if they have data. It should do this until the last row.
The code currently sees all rows as empty and therefor skips them, I need an if condition or do until statement that will help detect and skip empty rows, detect rows with data and merge their cells and stop entirely when it reaches the last row.
My current code:
Sub merge()
Dim LastRow As Long, i As Long
Sheets("Body").Activate
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
Rows("1:1").Select
For i = 1 To LastRow
If Range("A" & i).Value = "*" Then
Selection.merge = True
Selection.Offset(1).Select
Else
Selection.Offset(1).Select
End If
Next i
End Sub
I have also tried:
sub merge2()
Dim LastRow As Long, i As Long
Sheets("Body").Activate
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
Rows("1:1").Select
Do Until ActiveCell.EntireRow > LastRow
'this line below was a concept
If ActiveCell.EntireRow & ActiveCell.Column.Value = "*" Then
Selection.merge = True
Selection.Offset(1).Select
Else
Selection.Offset(1).Select
End If
Loop
End Sub
This is untested but should do what you want.
Option Explicit
Sub merge()
Dim ws As Worksheet
Dim LastRow As Integer, i As Integer
Set ws = ThisWorkbook.Sheets("Body")
ws.Activate
With ws
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
For i = 1 To LastRow
If Not IsEmpty(Range("A" & i)) And ws.Cells(i, Columns.Count).End(xlToLeft).Column > 1 Then
ws.Rows(i & ":" & i).merge
End If
Next i
End Sub
This If will test for a) whether the cell in column A is empty and b) whether there are any other cells in that row. if statement a evaluates to false AND statement b is greater than 1 it will execute the If statement
#Tom I've taken your code and added in an error handler that makes it work without fault, thank you very much for your patience, you've been a fantastic help.
Sub merge2()
Dim ws As Worksheet
Dim LastRow As Integer, i As Integer
Set ws = ThisWorkbook.Sheets("Body")
ws.Activate
With ws
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
For i = 1 To LastRow
If Not IsEmpty(Range("A" & i)) And ws.Cells(i, Columns.Count).End(xlToLeft).Column >= 1 Then
On Error Resume Next
ws.Rows(i & ":" & i).merge = True
End If
Next i
End Sub
The below code works great for copying an entire row, how do I make it so I only copy over the first column.
I have tried altering range with no success? Condition is in J, the only column to copy should be 1st one.
Dim cell As Range
Dim lastRow As Long, i As Long
lastRow = Range("B" & Rows.Count).End(xlUp).Row
i = 1
For Each cell In Sheets(1).Range("J1:J" & lastRow)
If cell.Value = 1 Then
cell.EntireRow.Copy Sheets(5).Cells(i, 1)
i = i + 1
End If
Next
End Sub
Many thanks!
try
Dim cell As Range
Dim lastRow As Long, i As Long
lastRow = Range("B" & Rows.Count).End(xlUp).Row
i = 1
For Each cell In Sheets(1).Range("J1:J" & lastRow)
If cell.Value = 1 Then
cells(cell.row,1).Copy Sheets(5).Cells(i, 1)
i = i + 1
End If
Next
End Sub
Dim cell As Range
Dim lastRow As Long, i As Long
lastRow = Range("B" & Rows.Count).End(xlUp).Row
i = 1
For Each cell In Sheets(1).Range("J1:J" & lastRow)
If cell.Value = 1 Then
cell.End(xlToLeft).Copy Sheets(5).Cells(i, 1)
i = i + 1
End If
Next
End Sub
Just switch EntireRow to EntireColumn, it is as simple as that! ;)
Dim rCell As Range
Dim lastRow As Long, i As Long
lastRow = Range("B" & Rows.Count).End(xlUp).Row
i = 1
For Each rCell In Sheets(1).Range("J1:J" & lastRow)
If rcell.Value = 1 Then
rcell.EntireColumn.Copy Sheets(5).Cells(1, i)
i = i + 1
End If
Next rCell
I have two sheets. I want to check the value in one column against the value in the same column in the second sheet. If they match, then I want to migrate the string data from the Notes column to the new sheet. (essentially I'm seeing if last week's ticket numbers are still valid this week, and carrying over the notes from last week).
I am trying to do this with the following code (using columns Z for the data, BE for the notes):
Sub Main()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")
Dim partNo2 As Range
Dim partNo1 As Range
Dim partNo3 As Range
For Each partNo2 In ws1.Range("Z1:Z" & ws1.Range("Z" & Rows.Count).End(xlUp).Row)
For Each partNo1 In ws2.Range("Z1:Z" & ws2.Range("Z" & Rows.Count).End(xlUp).Row)
For Each partNo3 In ws1.Range("BE1:BE" & ws2.Range("BE" & Rows.Count).End(xlUp).Row)
If StrComp(Trim(partNo2), Trim(partNo1), vbTextCompare) = 0 Then
ws2.Range("BE" & partNo1.Row) = partNo3
End If
Next
Next
Next
'now if no match was found then put NO MATCH in cell
For Each partNo1 In ws2.Range("E1:F" & ws2.Range("A" & Rows.Count).End(xlUp).Row)
If IsEmpty(partNo1) Then partNo1 = ""
Next
End Sub
Untested:
Sub Main()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim rng1 As Range, rng2 As Range
Dim c As Range, f As Range
Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")
Set rng1 = ws1.Range("Z1:Z" & ws1.Range("Z" & Rows.Count).End(xlUp).Row)
Set rng2 = ws2.Range("Z1:Z" & ws2.Range("Z" & Rows.Count).End(xlUp).Row)
For Each c In rng1.Cells
Set f = rng2.Find(c.Value, , xlValues, xlWhole)
If Not f Is Nothing Then
f.EntireRow.Cells(, "BE").Value = c.EntireRow.Cells(, "BE").Value
End If
Next c
'now if no match was found then put NO MATCH in cell
For Each c In ws2.Range("E1:F" & ws2.Range("A" & Rows.Count).End(xlUp).Row)
If Len(c.Value) = 0 Then c.Value = "NO MATCH"
Next
End Sub
This accomplishes the same result (maybe with the exception of the columns E & F at the bottom with NO MATCH). It's just a different way of going about it. Instead of using ranges, I'm just looking at each cell and comparing it directly.
TESTED:
Sub NoteMatch()
Dim lastRow1 As Long
Dim lastRow2 As Long
Dim tempVal As String
lastRow1 = Sheets("Sheet1").Range("Z" & Rows.Count).End(xlUp).row
lastRow2 = Sheets("Sheet2").Range("Z" & Rows.Count).End(xlUp).row
For sRow = 2 To lastRow1
tempVal = Sheets("Sheet1").Cells(sRow, "Z").Text
For tRow = 2 To lastRow2
If Sheets("Sheet2").Cells(tRow, "Z") = tempVal Then
Sheets("Sheet2").Cells(tRow, "BE") = Sheets("Sheet1").Cells(sRow, "BE")
End If
Next tRow
Next sRow
Dim match As Boolean
'now if no match was found, then put NO MATCH in cell
For lRow = 2 To lastRow2
match = False
tempVal = Sheets("Sheet2").Cells(lRow, "Z").Text
For sRow = 2 To lastRow1
If Sheets("Sheet1").Cells(sRow, "Z") = tempVal Then
match = True
End If
Next sRow
If match = False Then
Sheets("Sheet2").Cells(lRow, "BE") = "NO MATCH"
End If
Next lRow
End Sub