I am trying to write a macro that would go through the column and see if current cell contains value (reading from left) from the previous row, same column. elow is an example image with yellow cells marked for deleting. For example, there's cell with value "22.2" and next contains that same value and ".1" at the end, meaning that it's a sub-item and needs to be deleted.
What I have in mind code wise is this:
Sub DeleteSubparts()
'Declare variables
Dim LastRow As String
LastRow = Cells(Rows.Count, "E").End(xlUp).Row
'Delete parts subgroup
For i = 2 To LastRow
If Cells(i, 10).Value = Left(Cells(i - 1, 10)) Then
Cells(i, 10).Value = ""
End If
Next i
End Sub
This idea is not really the best approach, but each value in that column "J" is unique and sorted A-z so this idea should work. But general goal is to see if there's a subpart of any part in the list and if so - delete that subpart.
Could someone, please, assist me with finishing that code?
P.S. In my code it just blanks the cell for testing sakes, but there's some problem in how I wrote the code. It returns "Argument not optional" error
EDIT:
Trying something taht seems more correct and doesn't return an error, but still does nothing that's visible nor intended.
If Cells(i, 10).Value = Left(Cells(i - 1, 10), Len(Cells(i - 1, 10))) Then
Cells(i, 10).Value = ""
End If
This will delete the entire row containing the "child" cell.
Option Explicit
Sub DeleteRows()
Dim row As Long
Const col As Integer = 10 ' col J
With Worksheets("Sheet1")
' Start on second row of data
row = 2
Do While .Cells(row, col).Value <> ""
' Use Like to compare the value of the current cell to the value of the previous cell
If .Cells(row, col).Value Like .Cells(row - 1, col).Value & ".*" Then
.Rows(row).Delete
Else
row = row + 1
End If
Loop
End With
End Sub
or this will just clear the child cell contents.
If .Cells(row, col).Value Like .Cells(row - 1, col).Value & ".*" Then
.Cells(row, col).Clear
End If
row = row + 1
Related
So I have an excel sheet that can have anywhere from 5-1500 lines. Most lines have: 1) Title Row, 2) patient information, 3) blank row. Then it repeats. Some lines have 1) Title Row, 2) patient info, 3) additional patient info, 4)blank row. I need to insert a line between Rows 2&3 if there is info in row 3. Does this make sense?
Example:
--------A---------------------b-----------------c-------------------d--------
1-----acct #--------patient name------dr name------ date of service
2------123456-------Mickey Mouse-----Donald Duck--------1/4/19
3----------((((((((((((((all of this row is blank)))))))))))))))))))))----------
Or it could be this:
--------A---------------------b--------------------c-------------------d------
1-----acct #--------patient name--------dr name------ date of service
2------123456-------Mickey Mouse-----Donald Duck--------1/4/19
3------123456-------Mickey Mouse-----Donald Duck--------1/4/19
4----------((((((((((((((all of this row is blank)))))))))))))))))))))----------
Then this same format repeats throughout the sheet with different info of course. What I need is if row 3 has any info then insert a row between tows 2 & 3, but if row 3 is blank then skip to the next set.
This is the code I have so far but it is adding rows every other row no matter what.
Sub Macro()
Dim lastRow As Integer
lastRow = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.count).Row
Dim I As Long
For I = 6 To lastRow
If Cells(I + 2, 9).Text <> "" Then
Rows(I + 1).EntireRow.Insert Shift:=xlDown
lastRow=lastRow+1
End If
Next I
End Sub
As #BruceWayne stated in the comments, When inserting or deleting rows, columns or cells, it's helpful to iterate backwards. The Step parameter of a For-Next loop allows you to define how you would like to iterate. It defaults to Step 1. So instead of iterating from I = 6 to lastRow try
Dim lastRow As Long
Dim i As Long
lastRow = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row
For i = lastRow To 6 Step -1
If Cells(i - 1, 9).Text <> "" And Cells(i, 9).Text <> "" Then
Rows(i).EntireRow.Insert Shift:=xlDown
End If
Next i
This would insert a row at your current iteration if both the current cell and the cell above it had data in them.
It's worth noting that if you were to iterate to row 1, the If statement above would raise an error, but you'd never need to.
EDIT:
If what you need is to only add a row between patient info and additional patient info, you'd need to find a consistently identifiable piece of data to add as a condition to the If statement.
Give this a try.
Customize the variables to fit your needs
Sub InsertRows()
' Define object variables
Dim rangeEval As Range
Dim currentCell As Range
' Define other variables
Dim sheetName As String
Dim rowCounter As Integer
' >>>> Customize this
sheetName = "Sheet1"
' Initialize the used range in column A ' Change the number in .Columns(1) to use another column
Set rangeEval = ThisWorkbook.Worksheets(sheetName).UsedRange.Columns(1)
' Loop through each cell in range
For Each currentCell In rangeEval.Cells
' We use this counter to check if we are every third row
rowCounter = rowCounter + 1
' If this is the third row and there is something in the cell, insert one row
If rowCounter Mod 3 = 0 And currentCell.Value <> vbNullString Then
currentCell.EntireRow.Insert
' Reset the counter if there is nothing in the cell
ElseIf currentCell.Value = vbNullString Then
rowCounter = 0
End If
Next currentCell
End Sub
I am trying to replicate this view where new rows in the bottom table are created based on the values in Column'A' of the top table.
Here is my code:
Sub testProc()
Worksheets("Sheet1").Activate
Dim r, count As Range
Dim LastRow As Long
Dim temp As Integer
'Dim lngLastRow As Long
Set r = Range("A:L")
Set count = Range("A:A")
LastRow = Range("F" & 9).End(xlUp).Row
'LastRow = Cells(Rows.count, MyRange.Column).End(xlUp).Row
For n = LastRow To 1 Step -1
temp = Range("A" & n)
If (temp > 0) Then
Rows(n + 1 & ":" & n + temp).Insert Shift:=xlDown
Range("H" & (ActiveCell.Row) - 2).Copy Range("E" & (ActiveCell.Row) - 1)
Range("G" & (ActiveCell.Row)).Select
'ActiveCell.Offset(RowOffset:=1, ColumnOffset:=-6).Activate
'Cells(ActiveRow, 8).Value.Cut
'Cells.Offset(2 - 6).Value.Paste
'Range("G" & (ActiveCell.Row)).Select
'ActiveCell.Offset(0 - Selection.Column + 1).Range("A1:AG1").Select
'Value = Range(G, H)
'ActiveCell.Offset(1, -6).Paste
'ActiveCell.Offset(1, -6).Paste
'ActiveCell.Offset(RowOffset:=1, ColumnOffset:=-6).Paste
'Range.Offset(1, -6).Paste
'Value = Range("G" & (ActiveCell.Row), "H" & (ActiveCell.Row)).Value
'ActiveCell.Offset(2, -6).Range
'ActiveCell.Offset(rowOffset:=3, columnOffset:=3).Activate
End If
Next n
End Sub
I do not know what I am doing and Excel is crashing with and without messages
The easiest solution to this would be to use two separate worksheets, but you can work around this pretty easily with some math or a cell with a reserved word. You also want to use as few reference variables as possible and let Excel tell you what the ranges are defined as by using contiguous ranges.
I'm not going to write the whole function for you, but give you the building blocks that will let you piece it together and hopefully you'll learn more as you do it.
Here's how to set up the object variables that you'll reference throughout the code:
Dim sourceSheet as Worksheet
Dim targetSheet as Worksheet
' replace with the names of sheets you want to use
sourceSheet = Worksheets("Sheet1")
targetSheet = Worksheets("Sheet2")
Now, for looping through the source table. If you know that the first row in the Sheet is always the Title row and your instructions start in row 2 then you can use this to loop through every instruction:
Dim sourceRowIndex = 2
While Not IsEmpty(sourceSheet.cells(sourceRowIndex, 1))
' ** do stuff here
' increment row index
sourceRowIndex = sourceRowIndex + 1
Wend
You could also use a For Each loop or a For Next or a Do While, take your pick once you understand the logic used.
Note that "Cells" takes two numbers - the row number then the column number. This is very handy when you're looping through a series of rows and columns and don't want to have to deal with addresses like A1 or C5.
This will loop through everything in the top table, but now you need to add an inner loop that will actually process the instructions. Add all of the code below after the While and before the Wend.
Finally, you need to add the rows to the Target. The trick here is to use the CurrentRegion property to figure out where the last row in the range is, then just add one to get the next blank row.
Dim targetFirstEmptyRow
' Look up the Current Range of cell A1 on target worksheet
targetFirstEmptyRow = targetSheet.cells(1,1).CurrentRegion.Rows + 1
Then to assign values don't use copy and paste, just assign the values directly. This will write the first row you have defined:
targetSheet.cells(targetFirstEmptyRow, 1).value = sourceSheet.cells(sourceRowIndex, 1).value
targetSheet.cells(targetFirstEmptyRow, 4).value = sourceSheet.cells(sourceRowIndex, 4).value
targetSheet.cells(targetFirstEmptyRow, 5).value = sourceSheet.cells(sourceRowIndex, 5).value
Then after you write out those three values you can get the next empty row by using this again (note that your sourceRowIndex hasn't changed):
targetFirstEmptyRow = targetSheet.cells(1,1).CurrentRange.Rows + 1
Using the cells(row, column) logic it's pretty easy to write the second row as well:
targetSheet.cells(targetFirstEmptyRow, 2).value = sourceSheet.cells(sourceRowIndex, 6).value
targetSheet.cells(targetFirstEmptyRow, 3).value = sourceSheet.cells(sourceRowIndex, 7).value
targetSheet.cells(targetFirstEmptyRow, 6).value = "Dev"
Adding the third row (when it's required) is nearly exactly the same as the second. However, you want to check to see if the third row is necessary:
If sourceWorksheet.cells(sourceRowIndex, 1) = 3 Then
' insert your third row here
End If
Here's the entire function in pseudo-code so you can piece it all together:
Set up worksheet variables
While loop through every Source row
Find next empty row in Target
Copy Row 1
Find next empty row in Target
Copy Row 2
If 3 rows
Find next empty row in Target
Copy Row 3
Increment Source Row Index
Wend
Finally, if you don't want to see the screen flashing (and you want to speed the code execution up a little) look into Application.Screenupdating to turn off screen redraw as this does its work. Just remember to turn it on again once you've finished processing everything.
I am looking for a quick way to fill some fields based on a the following condition. (See image)
I have a list containing 3 columns. I need to fill Column C depending on the letter in Column A. When I go to C34 I would like to automatically search the rows above and based on the letter in Column A copy the 11 names from the latest occurrence above. So in C34-C44 the names from C1-C11 would get copied as a block.
Is there a function in Excel that can do that?
You can use a simple VBA macro with two FOR loops to solve your issue:
Sub CompleteRows()
Dim lastrow As Long
lastrow = Cells(Rows.Count, "A").End(xlUp).Row 'finds last row in column A
For x = 1 To lastrow 'loop that starts with value 1 and goes all the way to the value of lastrow
If Cells(x, 3).Value = "" Then 'if value in column C is empty then continue on
For y = 1 To lastrow 'second loop that runs through the same range
If Cells(y, 1).Value = Cells(x, 1).Value And Cells(y, 2).Value = Cells(x, 2).Value Then
'If the value of the first column and the value of the second
'column for both values match, then add value to column C
Cells(x, 3).Value = Cells(y, 3).Value
Exit For 'Exit loop if value was found
End If
Next y
End If
Next x
End Sub
I have a spreadsheet with a bunch of data all in one column and I'm looking to pull out specific data. I'm trying to see if a 'do until loop' will work.
I'm trying to get the loop to stop when it see "directory*" as part of the cell for example Directory of G:\Example. Until then the loop should look through the Cells and if it doesn't start with a number copy that cell to another sheet/column.
Sub Order()
iRow = 1
Do Until Cells(iRow, 1) = "Directory*"
If Cells(iRow, 1) <> NumberatBeginning Then
Cells(iRow, 1).Copy _
Destination:=Worksheets("Sheet2").Range("A1")
End If
iRow = iRow + 1
Loop
End Sub
Any help would be appreciated
You're almost there, the IsNumeric function can be used in conjunction with the Mid (or Left) function to check the first character in the cell value and return True or False if the character is numeric. Try this:
Sub Order()
Dim iRow as Long, x as Long
iRow = 1
x = 1
Do Until Cells(iRow, 1).Value Like "Directory*"
If Not IsNumeric(Mid(Cells(iRow, 1).Value, 1, 1)) Then
Worksheets("Sheet2").Cells(x, 1).Value = Cells(iRow, 1).Value
x = x + 1
End If
iRow = iRow + 1
Loop
End Sub
You should avoid using copy and paste as it slows down code, it is always better to simply set the value of the cell.
Also, when you're looping through and copying the cells with non-numeric first characters and pasting them into Sheet2 your code is always pasting into the same cell, Range("A1"), assuming you want a list of the values you will need to increment this by adding a row each time a value is copied to Sheet2.
I need to get a VBA code to excel for following criteria.
If any cell in the range of B1 to B500 contains "TOTAL:", divide same row value in column V with same row value in Column P where "TOTAL:" text exists.
Answer should be in same row column M.
I tried to develop the code like this:
Sub test()
Dim r As Range
For Each r In Range("B1", Range("B" & Rows.Count).End(xlUp))
If r.Value Like "TOTAL:" Then
With Range("M1:M10")
r.Formula = "=V5/P1"
End With
End If
Next
End Sub
If you want to learn VBA, I'd recommend you to solve those problems on your own by searching for 'loop through range' and 'compare string' and so on. That would be much more valuable for you on a long-term.
Anyway, for now you can try this. Please note that it doesn't provide any error handling etc...
Search Range:
For row = 1 To Cells(ws.Rows.Count, "B").End(xlUp).row loops through the rows from 1 to the last row with a value in column B. If you, for some reason, want to exclude just that very last row and stop at the second last, just substract 1 from it. If you seriously want a fixed range, change the whole thing to For row = 1 To 500.
Sub test()
Dim ws As Worksheet
Dim row As Long
Set ws = Sheet1 'insert name of sheet
For row = 1 To Cells(ws.Rows.Count, "B").End(xlUp).row
If StrComp(Cells(row, 2).Value, "TOTAL:", vbTextCompare) = 0 Then
Cells(row, 13).Value = Cells(row, 22).Value / Cells(row, 16).Value
End If
Next row
End Sub