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
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 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'm trying to use the trim function without success. After searching for the solution on this forum and other sources online I have seen many different approaches.
Is there no simple way of trimming a cell in VBA?
What I want is something like this:
Sub trimloop()
Dim row As Integer
row = 1
Do While Cells(row, 1) <> ""
Cells(row, 2) = trim(Cells(row, 2))
row = row + 1
Loop
So that when there is a value in column A (1) the value in column B (2) should be trimmed of any extra spaces. I just cant get this to work for me.
Appreciate any help/tips!
Regards
Jim
So i made the code a bit accurate and mistakeproof and it worked.
So i can recommend you to double check, if you have correct row and column values, because you probably targeting wrong cells. (cause your code is working)
Sub trimloop()
Dim row As Integer
Dim currentSheet As Worksheet
Set currentSheet = sheets("Sheet1")
row = 2
Do While currentSheet.Cells(row, 1) <> ""
currentSheet.Cells(row, 2).Value = Trim(currentSheet.Cells(row, 2).Value)
row = row + 1
Loop
End Sub
Use Application.WorksheetFunction.Trim(string)
Sub trimloop()
Dim row As Integer
row = 1
With ThisWorkbook.ActiveSheet
Do While .Cells(row, 1) <> ""
.Cells(row, 2) = Application.WorksheetFunction.Trim(.Cells(row, 2))
row = row + 1
Loop
End With
End Sub
this is the optimized version of your code, in case of big data sheets:
Option Explicit
Sub trimloop()
Dim row As Long, max As Long
Dim Data() As Variant
With ThisWorkbook.Sheets(1)
max = .Cells(1, 1).End(xlDown).row 'this does the same as your code, on first empty cell it stops
'the following finds the last un-empty cell of column(1):
'max= .cells(.rows.count,1).end(xlup).row
'copies values from sheet to memory (is faster for working with later)
Data = .Range(.Cells(1, 1), .Cells(max, 2)).Value2
'loop :
For row = 2 To max + 1
'work with memory instead of sheet
Data(row, 2) = Trim(Data(row, 2))
'for complete delete of all spaces use : = replace( StringName," ", "")
Next row
'write back to sheet
.Range(.Cells(1, 1), .Cells(max, 2)).Value2 = Data
End With
erase Data 'free memory
End Sub
Don't know if this overly simplified... but thought I would simply throw it out there this worked for me. The only predecessor step is you assign a "named range" to your workbook/worksheet/dataset ... name a data set and then iterate over the data set with this code
Sub forEachLoop()
For Each cell In Range("yourNamedRange")
cell.Value = Trim(cell.Value)
Next cell
End Sub
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 am new to VBA and I've been working on a VBA project that needs to find the empty cell and add all the cells above that empty cell and also place the sum on it. I tried finding the right code for it but no luck. Any suggestions will be greatly appreciated.
Here's the part of the data in the project:
Thank you!
Actually, your question is not clear. The logic of my code is
Looping all row between startRow and lastRowAnd find blank cell(#N/A).If found, adding values of all above cell from that cell and set total to that cell.But the adding is quarterly. And If continuous cells are found, set 0.
Means:If startRow = 1 and lastRow = 11, blank cell are 5, 10 and 11.
So, total value from row 5 cell is adding of above 4 cell(1+2+3+4) and
total value from row 10 cell is also adding of above 4 cell(6+7+8+9).And total value from row 11 cell is 0. Don't know logic to do.
I think that I give an right answer. I already tested the code. It perfectly work for me. If it is not for you, let me know. Here the code:
Public Sub findTotal()
Dim startRow, lastRow As Long
Dim row, innerStart As Long
With Sheets("Budget")
'Set start row
startRow = 1
innerStart = startRow
'last row must be last blank row for add all cell above from that
lastRow = 35
'Looping all row between startRow and lastRow
For row = startRow To lastRow Step 1
'Loop until blank
If .Range("N" & row).Text = "#N/A" Then
If row - startRow > 0 And row <> innerStart Then
'Set total of above cell to blank cell
.Range("N" & row) = WorksheetFunction.Sum(.Range("N" & row - 1, "N" & innerStart))
'Set next start row for adding next blank cell
innerStart = row + 1
Else
'Set 0 for continuous cells
.Range("N" & row) = 0
'Here, if you want to set above total, you can use as follow:
'.Range("N" & row) = .Range("N" & row - 1)
End If
End If
Next row
End With
End Sub