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
Related
I have two Excel worksheets with numerical ids in. I wish to compare list one against list two and where matches are found return the respective cell addresses for each match.
I am able via VBA to look through each list and return the address of the match in the small list but not of the match found in the larger list.
Any help would be appreciated. I guess the reality is that the message of the address it currently displays is simply the next cell in the loop.
Sub FindMatchAddress()
Dim ws As Worksheet
Dim wsInp As Worksheet
Dim wsRD As Worksheet
Dim rngInp As Range
Dim rngRD As Range
Set wsInp = Worksheets("Sheet1")
Set wsRD = Worksheets("Sheet2")
Set rngInp = wsInp.Range("B2:B11")
For Each cell In rngInp
If IsError(Application.Match(cell, rngRD, 0)) Then
Else
MsgBox cell.Address
cell.Offset(, 12) = "Found"
End If
Next cell
End Sub
Thank you.
What about using Range.Find? And also setting rngRd as pointed out in the comments.
Option Explicit
Sub FindMatchAddress()
Dim ws As Worksheet
Dim wsInp As Worksheet
Dim wsRD As Worksheet
Dim rngInp As Range
Dim rngRD As Range
Dim rng As Range, tmpRng As Range
Set wsInp = Worksheets("Sheet1")
Set wsRD = Worksheets("Sheet2")
Set rngInp = wsInp.Range("B2:B11")
Set rngRD = wsInp.Range("D2:D16")
For Each rng In rngInp
Set tmpRng = rngRD.Find(What:=rng.Value, LookIn:=xlValues, LookAt:=xlWhole)
If Not tmpRng Is Nothing Then
MsgBox tmpRng.Address
rng.Offset(, 12) = "Found"
End If
Next rng
End Sub
Phil, reading into your question, I'm taking for granted that the "numerical ids" are in the same column but on different worksheets. If I'm correct then, the below code should work as is. The code finds matching values in worksheet2 and instead of just placing just "Found" in worksheet1, "column N", I add worksheet2's name and the cell address. if your "numerical ids" are in different columns, please change the ws2 column letter to suit you. I've tested it on mock data and it works fine. I've tried to keep it as simple as I could.
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Set ws1 = ThisWorkbook.Worksheets("Sheet1")
Set ws2 = ThisWorkbook.Worksheets("Sheet2")
Dim lRow1 As Long
lRow1 = ws1.Range("B" & Rows.Count).End(xlUp).Row
Dim lRow2 As Long
lRow2 = ws2.Range("B" & Rows.Count).End(xlUp).Row
For i = 2 To lRow1
For j = 2 To lRow2
If ws1.Range("B" & i).Value = ws2.Range("B" & j).Value Then
ws1.Range("B" & i).Offset(, 12).Value = "Found: " & ws2.Name & "." & ws2.Range("B" & j).address
End If
Next j
Next i
I have a macro that looks for records in Column B and if there is a value in a cell within that column then the macro will add a value to Column A in the same row. My problem occurs when Column B has NO values in it whatsoever. The macro just continues running endlessly in those instances. What I am looking for is a way to say:
If Column B contains NO value then skip to the next macro.
I know this involves an IF statement of some kind I just can not figure out how to add that logic into my existing code.
My code:
Sub Update_Column_Based_On_Column_Value_1()
On Error Resume Next
Dim ws As Worksheet
Dim lRow As Long
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
lRow = .Range("B" & .Rows.Count).End(xlUp).Row
.Range("A1:A" & lRow).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=If(LEN(RC2),""NEW VALUE GOES HERE"", TEXT(,))"
.Range("A1:A" & lRow).Value = .Range("A1:A" & lRow).Value
End With
End Sub
My search for the answer yielded this string of code from another StackOverflow question:
If WorksheetFunction.CountBlank(emailRng) = emailRng.Cells.Count Then Exit Sub 'No data
When I added that to my code it simply ended the sub if there were ANY blank cells in a column.
Thanks in advance for the assistance! I do apologize if my question is overly noobish.
Try this:
Sub Update_Column_Based_On_Column_Value_1()
On Error Resume Next
Dim ws As Worksheet
Dim lRow As Long
Set ws = ThisWorkbook.Sheets("Sheet1")
' This will count all non-blanks in Column B, I put equal to 1
' because I am assuming B1 is a header with a title so it will at minimum be 1
If WorksheetFunction.CountA(ws.Range("B:B")) = 1 Then
' if count is equal to 1 then this part will run
' so enter name of the sub() or write new code in here
Else
' if not less than or equal, meaning greater than 1
' then the following code below will run
With ws
lRow = .Range("B" & .Rows.Count).End(xlUp).Row
.Range("A1:A" & lRow).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=If(LEN(RC2),""NEW VALUE GOES HERE"", TEXT(,))"
.Range("A1:A" & lRow).Value = .Range("A1:A" & lRow).Value
End With
End If
This code will do what you want
Sub test()
Dim i As Long
Dim lRow As Long
lRow = Cells(Rows.Count, "B").End(xlUp).Row
For i = 2 To lRow
If Cells(i, "B").Value <> vbNullString Then
Cells(i, "A").Value = Cells(i, "B").Value
End If
Next i
End Sub
I have Cell A1 with Month mentioned. I am trying to compare date in A2:last cell and wherever date > A1, I want the row to be unlocked, otherwise locked. The below code doesn't work"
Sub Lockrow()
Dim DestSh As Worksheet
Dim lastrow As Long
Dim i As Integer
Set DestSh = Sheets("Consultant & Volunteer")
With DestSh
'finds the last row with data on A column
lastrow = .Range("A" & .Rows.Count).End(xlUp).Row
'parse all rows
For i = 6 To lastrow
'if your conditions are met
If Month(.Cells(i, 26)) > Month(.Cells(1, 1)) Then
.Range("A" & i).EntireRow.Cells.Locked = True 'lock the row
End If
Next i
End With
End Sub
This can be done simply with below, but you have to be careful that Year doesn't change... Also the lastrow should be on Column Z.
Also, if the worksheet isn't Protected, there is no effect.
Option Explicit
Sub Lockrow()
Dim DestSh As Worksheet
Dim lastrow As Long
Dim i As Long ' Integer
Set DestSh = Sheets("Consultant & Volunteer")
With DestSh
'finds the last row with data on A column
lastrow = .Range("Z" & .Rows.Count).End(xlUp).Row ' <-- EDIT
'parse all rows
For i = 6 To lastrow
'if your conditions are met
.Rows(i).Locked = Not (Month(.Cells(i, "Z")) > Month(.Range("A1")))
' If Month(.Cells(i, 26)) > Month(.Cells(1, 1)) Then
' .Range("A" & i).EntireRow.Cells.Locked = True 'lock the row
' End If
Next i
.Protect UserInterfaceOnly:=True
End With
Set DestSh = Nothing
End Sub
Alternative to loop.
Dim r As Range, DestSh As Worksheet, lastrow As Long
Set DestSh = Sheets("Consultant & Volunteer")
With DestSh
lastrow = .Range("A" & .Rows.Count).End(xlUp).Row
Set r = .Range("A1:A" & lastrow)
r.EntireRow.Locked = False
r.AutoFilter 1, ">" & .Range("A1").Value2
r.SpecialCells(xlCellTypeVisible).EntireRow.Locked = True
.AutoFilterMode = False
.Protect UserInterfaceOnly:=True
End With
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
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