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
Related
I have a dataset that includes 9 columns. I want to check each row to see if the last 3 columns are empty. If all 3 are empty, I want to delete the row. I'm currently trying to do this in VBA, but I'm a programming newb and find myself completely overwhelmed.
The pseudocode that I've written is as follows:
For Row i
If(Col 1 & Col 2 & Col 3) = blank
Then delete Row i
Move on to next Row
I'd go like follows
Dim iArea As Long
With Range("E:G") '<--| change "E:G" to your actual last three columns indexes
If WorksheetFunction.CountBlank(.Cells) < 3 Then Exit Sub
With .SpecialCells(xlCellTypeBlanks)
For iArea = .Areas.Count To 1 Step -1
If .Areas(iArea).Count Mod 3 = 0 Then .Areas(iArea).EntireRow.Delete
Next
End With
End With
Assuming you have at least one row that is always filled out, you can use the following:
Dim LR as Long
Dim i as Integer
LR = Cells(Sheets("REF").Rows.Count,1).End(xlUp).Row
For i = 1 to 9
If Range(Cells(LR-3,i),(Cells(LR,i)).Value="" Then
Columns(i).Delete
Else:
End If
Next i
This works by defining the last row as LR, and defining a variable as i. You will check column "i" to determine if the last 3 rows of the column are "", aka it's blank; one might try to use ISBLANK(), but that cannot work for an array. If this is true, then you will delete the column, i. The code will then move to the next i. The FOR LOOP using i starts at 1 and goes to 9, which corresponds to starting at column 1 (A) and ending at column 9 (I).
Edit:
I appear to have misread which was supposed to be empty and which is supposed to be deleted, in terms of columns/rows... this code would be re-written as:
Dim LR as Long
Dim i as Integer
LR = Cells(Sheets("REF").Rows.Count,1).End(xlUp).Row
For i = LR to 2 Step -1 'Assumes you have headers in Row1
If AND(ISBLANK(Cells(i,7)),ISBLANK(Cells(i,8)),ISBLANK(Cells(i,9)) Then
Rows(i).Delete
End If
Next i
Significant changes are checking is each of the 3 last columns in the row are empty, ISBLANK(), changing that a row gets deleted if the condition is met, and changing what to loop through.
Here's another answer, assuming your last three column starts on "G","H","I".
Sub DeleteRowWithLastThreeColumnsBlank()
Dim N As Long, i As Long
N = Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To N
If Cells(i, "G").Value = "" And Cells(i, "H").Value = "" And Cells(i, "I").Value = "" Then
Rows(i).EntireRow.Delete
N = Cells(Rows.Count, "A").End(xlUp).Row
End If
Next i
End Sub
I am trying to create a predictive algorithm in VBA that would search for strings in a particular row from a data source, and return a value based on the row number. This is the first step in the workflow, and in its simplest form, there are 2 tables as shown below:
Source Table:
Output Table:
This is what I'm trying to do:
Pick up the strings in Row 1 of Output Table (Blue,Black) and search for them in Rows 1,2,3,4 of Source Table.
If both strings match in a single row, the 'Input' cell from that particular row is copied to Row 1 in Output Table in the 'Output' column.
Example (2nd iteration):
From Output Table Row 2, strings Ivory,Green,Grey are picked up and queried in all rows of Source Table. If any 2 out of 3 strings match in a single row on Source Table, the Input cell of that row is copied.
In this case, Ivory and Green match in Row 1, and also in Row 4. Either input cell would work, but for the sake of having a rule, lets take the last match (Row 4). So '1,8' would be copied to Row 2 on Output Table.
This the flow I am currently using, but I'm getting an incorrect output:
For i = 2 To 5
For j = 1 To 4
For k = 2 To 5
For l = 1 To 5
If Cells(i, j).Value = Worksheets("SourceTable").Cells(k, l).Value And Cells(i,j).Value <> "" Then
For a = 1 To 5
For b = 1 To 4
If Cells(i, b).Value = Worksheets("SourceTable").Cells(k, a).Value And Cells(i, b).Value <> "" Then
Cells(i, 15).Value = Worksheets("SourceTable").Cells(k, 5).Value
GoTo iLoop
End If
Next b
Next a
End If
Next l
Next k
Next j
iLoop:
Next i
Both tables would have around half a million rows, and I am trying to figure out how to reduce the number of loops and make it work at the same time. Any suggestions would be appreciated, this would help me save a lot of man-hours and automate a major chunk of the process. Thanks!
Sub macro()
lastRowOut = Sheets("OutputTable").Range("A" & Rows.Count).End(xlUp).Row
lastRowSou = Sheets("SourceTable").Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To lastRowOut
For j = 2 To lastRowSou
If checkRow(j, i) >= 2 Then
Sheets("OutputTable").Cells(i, 5) = Sheets("SourceTable").Cells(j, 6)
Exit For
End If
Next j
Next i
End Sub
Function checkRow(sRow, i)
lastCol = Split(Sheets("OutputTable").Cells(i, Columns.Count).End(xlToLeft).Address, "$")(1)
counter = 0
For Each cell In Sheets("OutputTable").Range("A" & i & ":" & lastCol & i)
If Not Sheets("SourceTable").Range("A" & sRow & ":" & "E" & sRow).Find(cell.Value) Is Nothing Then
counter = counter + 1
End If
Next cell
checkRow = counter
End Function
Quite a few things are unclear so here were the assumptions I made:
Two or more of the cells in a row in the OutputTable have to be matched for the prediction to be made.
The first rows of both the Output and Source sheet contain "Col1, Col2" etc.
You seem to not mind whether we use the first or last matching row (from the source sheet) so I went with the first.
That's 3 loops instead of 6..
you can try this
Option Explicit
Sub main()
Dim row As Range
With Worksheets("OutputTable")
For Each row In .Range("D2", .Cells(.Rows.count, 1).End(xlUp)).Rows '<--| change "D" to "OutputTable" sheet last "col" column index (i.e. the one before "Output" column)
SearchSource row
Next
End With
End Sub
Sub SearchSource(rng As Range)
Dim cell As Range, row As Range
Dim nFounds As Long
With Worksheets("SourceTable")
For Each row In .Range("E2", .Cells(.Rows.count, 1).End(xlUp)).Rows '<--| change "E" to "SourceTable" sheet last "col" column index (i.e. the one before "Input" column)
nFounds = 0
For Each cell In rng.SpecialCells(xlCellTypeConstants)
If Not row.Find(what:=cell.Value, lookat:=xlWhole, LookIn:=xlValues) Is Nothing Then nFounds = nFounds + 1
If nFounds = 2 Then Exit For
Next
If nFounds = 2 Then rng.Cells(, rng.Columns.count + 1).Value = row.Cells(, row.Columns.count + 1).Value
Next
End With
End Sub
'Try this:
'First declare some variables:
'the number of rows of the Output table
Dim OrNum as integer
'the number of columns of the Output table
Dim OcNum as integer
'the number of rows of the Source table
Dim SrNum as integer
'the number of columns of the Source table
Dim ScNum as integer
'some dummy variables for the loops
Dim rO as integer, cO as integer
Dim rS as integer, cS as integer
And then declare a boolean variable (just for later on)
Dim bool as boolean
'Then assume the output table has it's first cell at the most 'top and the most left of the output table, which is taken to 'be the cell Z1 in the following Code
'Begin with this first cell of the Output table and get each 'value in a way, that you move first (inner loop) over the 'columns by fixing the row Index (rO) of the Output table and then (outer loop) get down to each and every row like this:
For rO = 0 to OrNum - 1
For cO = 0 to OcNum - 1
Range("Z1").Offset(rO, cO)
Next
Next
'Now you don't have only strings so you will need to check, 'if the value in the cell is a string or a number. There is VBA 'function, that can help. It's called IsNumeric. It will give 'True if the value is a numeric value. If we have a string, then it will give False. With the Function IsEmpty() you can also check if a cell is empty or not. If a cell is empty, then the function IsEmpty will return True.
For rO = 0 to OrNum - 1
For cO = 0 to OcNum - 1
bool = IsNumeric(Range("Z1").Offset(rO, cO).Value)
bool = bool Or IsEmpty (Range("Z1").Offset(rO, cO).Value)
If bool=False then
'we have a string!
'do something
End if
Next
Next
I am using a VBA code to insert rows below based on a specific text and its occurrence .
I am using the following code to do so
Sub try()
Dim c As Range
For Each c In Range("A1:A100")
If c.Value Like "*COLLECTION*" Then
c.Offset(1, 0).EntireRow.Insert
End If
Next c
End Sub
I want to have the text BALANCE below the COLLECTION cell instead of blank row.
I want to insert the BALANCE row below the last COLLECTION entry, for example if there are two collections rows serially then I want to add the BALANCE row after the 2nd collection row. but with the above VBA code I am getting blank rows below to the each collection row.
My Collection and balance rows are in the column A
Before macro Image kindly check
After macro I want like this Image kindly check
I would do this using a loop from row 1 till last filled row in column A. Then having a boolean marker which is true while the cell value in current cell is like "*COLLECTION*" but false while not. So if the current cell is not like "*COLLECTION*" but the marker is true then the last cell above the current cell was like "*COLLECTION*". Then insert a new row with "BALANCE" if that cell is not already "BALANCE".
Sub try()
Dim c As Range
Dim lRow As Long
lRow = 1
Dim lRowLast As Long
Dim bFound As Boolean
With ActiveSheet
lRowLast = .Cells(.Rows.Count, 1).End(xlUp).Row
Do
Set c = .Range("A" & lRow)
If c.Value Like "*COLLECTION*" Then
bFound = True
ElseIf bFound Then
bFound = False
If c.Value <> "BALANCE" Then
c.EntireRow.Insert
lRowLast = lRowLast + 1
c.Offset(-1, 0).Value = "BALANCE"
c.Offset(-1, 0).Font.Color = RGB(0, 0, 0)
End If
End If
lRow = lRow + 1
Loop While lRow <= lRowLast + 1
End With
End Sub
That's typically the kind of cases you want to start from the last cell, because inserting a row will mess up all counters from what is below.
In other words, the elegant for each is not really a good idea. Too unpredictable. An ugly, old simple For Step -1 is the way to go. Something like :
Sub Macro1()
For l = 100 To 1 Step -1
If Trim(Cells(l, 1)) = "COLLECTION" And Trim(Cells(l + 1, 1)) = "DEMAND" Then
Rows(CStr(l + 1) & ":" & CStr(l + 1)).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Cells(l + 1, 1) = "BALANCE"
End If
Next l
End Sub
Just tried on EXCEL 2013, seems to work as you want. There may be more elegant solutions, though.
EDIT : the idea is the following one :
_Begin by the last line(in fact, the last line cannot work, so one optimization could be to start from the prevo=ious one), and go to the first one
_If the line testes is "COLLECTION", and the next one is "DEMAND", then you need to insert a "BALANCE" line in between. It's done in 2 times, first insert an empty line, then add "BALANCE" in the newly created line.
I have a problem regarding this:
I need to make the blank cells' value equal to the value of the used cell before them. My desired outcome is this:
You can observe that the blank cells' value depends on the value of the used cell before them. Is there any way to achieve this using macro? Thanks.
You can also use this one:
Public Sub fillBlank()
Dim row, lastRow As Integer
With Sheets("sheetname")
'Getting the last use row.
lastRow = .Range("B1").SpecialCells(xlCellTypeLastCell).row
'looping from row 2 to last used row (let row 1 is not blank)
For row = 2 To lastRow Step 1
If .Range("C" & row) = "" Then
.Range("C" & row) = .Range("C" & row - 1)
End If
Next row
End With
End Sub
I found the answer myself after some time.
For i = 2 To last
If log.Sheets("Entry").Cells(i, 3) <> "" Then
If log.Sheets("Entry").Cells(i + 1, 3) = "" Then
log.Sheets("Entry").Cells(i + 1, 3) = log.Sheets("Entry").Cells(i, 3)
End If
End If
Next i
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