I am in the process of writing a macro that allows me to update data monthly. However, I realized that sometimes I will need to overwrite the data from the same month when there is a correction issued to the data. I am trying to come up with a macro that will allow me to search the entire column and if there is a match with the data, allow me to run another macro to overwrite the old data with the new data. Any ideas of how to go about this?
Here is what I have so far. I need to replace to i to 500 with the entire column.
Sub FindMatchingValue()
Dim i As Integer, ValueToFind As Integer
intValueToFind = Sheet8.Range("L6")
For i = 1 To 500 ' This needs to be the entire column
If Cells(i, 1).Value = intValueToFind Then
MsgBox ("Found value on row " & i)
Exit Sub
End If
Next i
MsgBox ("Value not found in the range!")
End Sub
You do not want to run a loop down your entire column (slightly over 1 mil X). Instead, find your last row form the bottom, and loop through that range.
If your goal is to run a second Macro when you do find a match, you can get rid of your msgbox and Exit Sub and replace with Call SecondMacro, where "SecondMacro" is the name you assigned to your sub of course. Just an option ~
Sub FindMatchingValue()
Dim i As Integer, ValueToFind As Integer, LRow as Integer
intValueToFind = Sheet8.Range("L6")
LRow = Range("A" & Rows.Count).End(XlUp).Row
For i = 1 To LRow
If Cells(i, 1).Value = intValueToFind Then
MsgBox ("Found value on row " & i)
Exit Sub
End If
Next i
MsgBox ("Value not found in the range!")
End Sub
Related
I've got a column: U. This column has values from U10 till U500.
What I need to get is the last changing value of the column and if it doesn't change then a text "False" or something and if the last changing value is an empty cell, then ignore that..
Column U
11
11
5
11
11
21
For example here the result should be 21.
I've tried comparing two rows and with conditional formatting but with such a big range doing all this for each row is a bit too much.
Does anybody know a good way to do this?
Something like that should do it ...
Sub test()
Dim LastRow As Long, i As Long
With Worksheets("Sheet1") 'your sheet name
LastRow = .Cells(.Rows.Count, "U").End(xlUp).Row 'find last used row in column U
For i = LastRow To 2 Step -1 'loop from last row to row 2 backwards (row 1 can not be compared with row before)
If .Cells(i, "U").Value <> .Cells(i - 1, "U").Value Then 'compare row i with row before. If it changes then ...
MsgBox "Last row is: " & .Cells(i, "U").Address & vbCrLf & _
"Value is: " & .Cells(i, "U").Value
Exit For 'stop if last changing row is found
End If
Next i
End With
End Sub
It loops from last used row in column U to the first row and checks if the current row is different from the row before. If so it stops.
i am not sure of the how you want the output.
IF(AND(RC[-1]<>R[-1]C[-1],ROW(RC[-1])>500,R[-1]C[-1]<>""),RC[-1],"")
try this formula in cells V10:V500
Try this Macro.
First run the AnalyseBefore sub and when you want to check if the value has changed run the AfterAnalyse sub.
Incase you want the range to be dynamic use the code that I have commented and include iCount in your Range calculation
Sub AnalyseBefore()
Dim iCount
Range("U10").Select
iOvalue = Range("U500").Value
'iCount = Selection.Rows.Count
Range("Z1").Value = iOvalue
End Sub
Sub AnalyseAfter()
Dim iCount
Range("U10").Select
iNValue = Range("U500").Value
Range("Z2").Value = iNValue
iOvalue = Range("Z1").Value
If (iOvalue = iNValue) Then
Range("U500").Value = "FALSE"
End If
End Sub
I have a workbook and I need to find the NO values on ROW G (Row 7) and then copy the line that NO belongs to a new sheet (TAB) called summary, in my case it is listed as sheet 18.
I need to search on all sheets though from Sheet 1 to Sheet 17 in their G Rows for NO's.
I have a code I have found online and amend it to work with my criteria. But it does not seem to work as I would like it to it keeps coming up with errors.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim nxtRow As Integer`enter code here`
'Determine if change was to Column G (7)
If Target.Column = 7 Then
'If Yes, Determine if cell = NO
If Target.Value = "NO" Then
'If Yes, find next empty row in Sheet 18
nxtRow = Sheets(18).Range("F" & Rows.Count).End(xlUp).Row + 1
'Copy changed row and paste into Sheet 18
Target.EntireRow.Copy _
Destination:=Sheets(18).Range("A" & nxtRow)
End If
End If
End Sub
Thank you in advance.
Vasilis.
http://s38.photobucket.com/user/Greekcougar/media/screenshot9_zpslhtkkfue.jpg.html
http://s38.photobucket.com/user/Greekcougar/media/sub%20macro_zpsngyjtsj9.jpg.html
Below is the code for the same. It has two sub procedures initiate and applyFilterAndCopy. In initiate you can specify the no. of sheets(sheetCount In below code I have mentioned as 2) you need to scan. While calling the second sub procedure inside first(initiate) you need to specify the column number and the text you are searching for as variables to the second sub procedure(Call applyFilterAndCopy(i, 1, "No") here I have mentioned as 1 i.e. 1st column and String to be searched as No in quotes). Please note the sheet names need to be in the format Sheet**** and summary sheet name as Summary case sensitive as mentioned in your description.
Sub initiate()
Worksheets("Summary").UsedRange.Delete
Dim i As Integer, sheetCount As Integer
sheetCount = 2
For i = 1 To sheetCount
Call applyFilterAndCopy(i, 1, "No")
Next i
End Sub
Sub applyFilterAndCopy(sheetNo As Integer, searchInColumn As Integer, textToSearch As String)
Worksheets("Sheet" & sheetNo).AutoFilterMode = False
Worksheets("Sheet" & sheetNo).Range("A1").AutoFilter Field:=searchInColumn, Criteria1:=textToSearch
DR = Worksheets("Summary").UsedRange.SpecialCells(xlCellTypeLastCell).Row
If IsEmpty(DR) = True Or DR = 1 Then
Worksheets("Sheet" & sheetNo).UsedRange.SpecialCells(xlCellTypeVisible).Copy _
Destination:=Worksheets("Summary").Range("A1")
Else
Worksheets("Sheet" & sheetNo).UsedRange.Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy _
Destination:=Worksheets("Summary").Range("A" & DR + 1)
End If
End Sub
Vba is not necessary for this. An easy way to do this is using a formula and filter.
Add a column to the sheet that looks at the previous row and checks if no is there. Then filter this column and you can then just copy and paste to your summary tab.
I'm in the need of your help to solve the basic exercise I encountered during the course of learning Excel VBA. So, here it is:
There is a list of rollercoasters, where one column represents the name of the rollercoaster, whilst another column its type. I have to loop down the list, until the empty cell, selecting only those rollercoasters, the type of which is "Wooden". The sub should end with a message box displaying all rollercoasters' names, that matched our "Wooden" criterion (every line of msgbox contains one name).
So, anyone could advise a new learner how to cope with the above...?
This will run on the first 1000 rows where column a is the rollercoasters and column b is the type. you can cahnge the number 1000 to another number or xldown if you desire.
Sub Macro1()
'
Dim Rollers As String
For i = 1 To 1000
If Cells(i, 2) = "Wooden" Then Rollers = Rollers & vbNewLine & Cells(i, 1).Value
If Cells(i, 1) = "" Then MsgBox (Rollers): End
Next i
'
End Sub
I would add to Balinti's answer. This will get you the last row to use instead of hardcoding 1000
Dim sht As Worksheet
Dim LastRow As Long
Set sht = ThisWorkbook.Worksheets("Sheet1")
LastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
Then you would have a loop that looked like this
For i = 1 To LastRow
Next i
MsgBox Rollers
Can anyone walk me through how to write a script to delete the entire row if a cell in column D = "" on sheet 3 in range D13:D40.
Also, how to prevent the user from accidentally running the script again once those cells in the range are already deleted and other cells are now on the D13:D40 range?
Solution: This is working for me:
Sub DeleteRowsWithEmptyColumnDCell()
Dim rng As Range
Dim i As Long
Set rng = ThisWorkbook.ActiveSheet.Range("D13:D40")
With rng
' Loop through all cells of the range
' Loop backwards, hence the "Step -1"
For i = .Rows.Count To 1 Step -1
If .Item(i) = "" Then
' Since cell is empty, delete the whole row
.Item(i).EntireRow.Delete
End If
Next i
End With
End Sub
Explanation: Run a for loop through all cells in your Range in column D and delete the entire row if the cell value is empty. Important: When looping through rows and deleting some of them based on their content, you need to loop backwards, not forward. If you go forward and you delete a row, all subsequent rows get a different row number (-1). And if you have two empty cells next to each other, only the row of the first one will be deleted because the second one is moved one row up but the loop will continue at the next line.
No need for loops:
Sub SO()
Static alreadyRan As Integer
restart:
If Not CBool(alreadyRan) Then
With Sheets("Sheet3")
With .Range("D13:D40")
.AutoFilter 1, "="
With .SpecialCells(xlCellTypeVisible)
If .Areas.Count > 1 Then
.EntireRow.Delete
alreadyRan = alreadyRan + 1
End If
End With
End With
.AutoFilterMode = False
End With
Else
If MsgBox("procedure has already been run, do you wish to continue anyway?", vbYesNo) = vbYes Then
alreadyRan = 0
GoTo restart:
End If
End If
End Sub
Use AutoFilter to find blank cells, and then use SpecialCells to remove the results. Uses a Static variable to keep track of when the procedure has been run.
Here's my take on it. See the comments in the code for what happens along the way.
Sub deleterow()
' First declare the variables you are going to use in the sub
Dim i As Long, safety_net As Long
' Loop through the row-numbers you want to change.
For i = 13 To 40 Step 1
' While the value in the cell we are currently examining = "", we delete the row we are on
' To avoid an infinite loop, we add a "safety-net", to ensure that we never loop more than 100 times
While Worksheets("Sheet3").Range("D" & CStr(i)).Value = "" And safety_net < 100
' Delete the row of the current cell we are examining
Worksheets("Sheet3").Range("D" & CStr(i)).EntireRow.Delete
' Increase the loop-counter
safety_net = safety_net + 1
Wend
' Reset the loop-counter
safety_net = 0
' Move back to the top of the loop, incrementing i by the value specified in step. Default value is 1.
Next i
End Sub
To prevent a user from running the code by accident, I'd probably just add Option Private Module at the top of the module, and password-protect the VBA-project, but then again it's not that easy to run it by accident in the first place.
This code executes via a button on the sheet that, once run, removes the button from the worksheet so it cannot be run again.
Sub DeleteBlanks()
Dim rw As Integer, buttonID As String
buttonID = Application.Caller
For rw = 40 To 13 Step -1
If Range("D" & rw) = "" Then
Range("D" & rw).EntireRow.Delete
End If
Next rw
ActiveSheet.Buttons(buttonID).Delete
End Sub
You'll need to add a button to your spreadsheet and assign the macro to it.
There is no need for loops or filters to find the blank cells in the specified Range. The Range.SpecialCells property can be used to find any blank cells in the Range coupled with the Range.EntireRow property to delete these. To preserve the run state, the code adds a Comment to the first cell in the range. This will preserve the run state even if the Workbook is closed (assuming that it has been saved).
Sub DeleteEmpty()
Dim ws As Excel.Worksheet
Set ws = ActiveSheet ' change this as is appropriate
Dim sourceRange As Excel.Range
Set sourceRange = ws.Range("d13:d40")
Dim cmnt As Excel.Comment
Set cmnt = sourceRange.Cells(1, 1).Comment
If Not cmnt Is Nothing Then
If cmnt.Text = "Deleted" Then
If MsgBox("Do you wish to continue with delete?", vbYesNo, "Already deleted!") = vbNo Then
Exit Sub
End If
End If
End If
Dim deletedThese As Excel.Range
On Error Resume Next
' the next line will throw an error if no blanks cells found
' hence the 'Resume Next'
Set deletedThese = sourceRange.SpecialCells(xlCellTypeBlanks)
On Error GoTo 0
If Not deletedThese Is Nothing Then
deletedThese.EntireRow.Delete
End If
' for preserving run state
If cmnt Is Nothing Then Set cmnt = sourceRange.Cells(1, 1).AddComment
cmnt.Text "Deleted"
cmnt.Visible = False
End Sub
I've recently had to write something similar to this. I'm not sure that the code below is terribly professional, as it involves storing a value in cell J1 (obviously this can be changed), but it will do the job you require. I hope this helps:
Sub ColD()
Dim irow As long
Dim strCol As String
Sheets("sheet2").Activate
If Cells(1, 10) = "" Then
lrun = " Yesterday."
Else: lrun = Cells(1, 10)
End If
MsgBox "This script was last run: " & lrun & " Are you sure you wish to continue?", vbYesNo
If vbYes Then
For irow = 40 To 13 step -1
strCol = Cells(irow, 4).Value
If strCol = "" Then
Cells(irow, 4).EntireRow.Delete
End If
Next
lrun = Now()
Cells(1, 10) = lrun
Else: Exit Sub
End If
End Sub
I want to find the value "No Results" and remove the row and two rows above it.
Name 1(A1)
(A2 is empty) App(B2) Efforts (C2)
No Results(A3)
Name 3 (A4)
Valid (A5)
Name 2(A6)
(A7 is empty)
No Results(A8)
I am able to remove the record were the value is, but not the records above it. Tried Cells(i-2, "A").EntireRow.Delete but it removes all records above it. Could you please help.
Sub Macro1()
Last = Cells(Rows.Count, "A").End(xlUp).Row
For i = Last To 1 Step -1
If (Cells(i, "A").Value) = "No Results" Then
Cells(i, "A").EntireRow.Delete
End If
Next i
End Sub
Something like this should do the trick:
Public Sub Macro1()
Dim i As Long
For i = Cells(Rows.Count, "A").End(xlUp).Row To 1 Step -1
If Cells(i, "A").Value = "No Result" Then
Range((i-2) & ":" & i).Delete
End If
Next i
End Sub
This works only if the sheet you want to 'filter' is the currently active sheet, if this is intended to run from a module it would be best to specify the sheet explicitly e.g. Sheets("Sheet1").Cells(i, "A").
The only real change I've made to your own attempt is the use of Range rather than Cells within your If statement. With the Range function we can reference an Excel range using a string e.g. Range("A1"). In this case specifically we construct a string referencing the rows (i-2) to i, so for i = 9 we are executing Range("7:9").Delete.