I have an excel sheet with a column containing data as follows and there is data in other columns.
Here there are blank cells between the rows. Between 1014,1027 there is 1 blank Cell. There are 3 blank Cells between 1027 and other 1027 and so on..
Script should delete the rows with more than one blank cell in "column A" between the rows that contains data in "column A".
Eg: Script should delete the rows 1027(starting row always has a value) and next three empty rows, so it should not delete the rows if the gap between two non-empty values is 1. The same process should be done for the entire sheet.
There are more than one empty cell between the following values.
Code
1014
1027
1027
1033
1033
1033
1020
1033
1008
Please suggest me on this.
Give this a try:
Sub rowKiller()
Dim N As Long, i As Long
N = Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To N - 1
If Cells(i - 1, 1) <> "" And Cells(i, 1) = "" And Cells(i + 1, 1) <> "" Then
Cells(i, 1).Value = "XXX"
End If
Next i
Range("A:A").Cells.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Range("A:A").Replace "XXX", ""
End Sub
Related
I have tried, and been unable to find any sample VBA code that fits my needs. What I'm trying to do is find duplicate matches between two columns and consolidate them with respect to a third column, then in a fourth column show how many instances of the duplicate existed originally.
The original data:
The ideal output after removing duplicates:
As you can see, in the output I have 1 instance of 1 in Column A, a in Column B, retained the first value the duplicates started at in Column C and express 2 occurences of the duplicates in Column D. Can anyone point me in the right direction? Any help would be greatly appreciated.
the below code will find the number of occurrences in fourth column and remove the duplicates
Sub foo()
row_count = 20
For i = 2 To row_count
Count = 1
For j = 2 To row_count
If i <> j And Cells(i, 1).Value <> "" Then
If Cells(i, 1).Value = Cells(j, 1).Value And Cells(i, 2).Value = Cells(j, 2).Value Then
Rows(j & ":" & j).Delete Shift:=xlUp
Count = Count + 1
j = j - 1
End If
End If
Next j
If Count > 1 Then
Cells(i, 4).Value = Count
End If
Next i
End Sub
I'm writing a code that copies data from one sheet into another and I've got that function working fine. Now, I'm trying to code it to delete any rows that contain duplicate information based off that information's ID number in column F. Part of our process is to manually enter in column E when each row has been worked.
So my end goal is for the code to delete rows where column E is blank and column F is a duplicate. My code runs, but doesn't delete anything. I'm really hoping I'm just missing something ridiculously obvious.
For i = 1 To Range("f" & Rows.Count).End(xlUp).Row
If Cells(i, 5).Value = "" Then 'if column E is blank on row i
x = Cells(i, 6).Value
If Not IsError(Application.Match(x, "F:F", 0)) Then '& if that row is a duplicate
ActiveSheet.Range(x).EntireRow.Delete 'delete new duplicate row
End If
End If
Next i
Try it with,
For i = Range("f" & Rows.Count).End(xlUp).Row to 1 Step -1
If Cells(i, 5).Value = "" Then 'if column E is blank on row i
x = Cells(i, 6).Value
If Application.Countif(Columns(6), x) > 1 Then '& if that row is a duplicate
Rows(i).EntireRow.Delete 'delete new duplicate row
End If
End If
Next i
You were trying to delete the row number x, not i. Additionally, everything was going to be matched once.
So there are a couple of errors that need to be addressed in your code. First, if you are looping over a range and deleting rows, it's best to start from the bottom and work your way up. This prevents issues where your iterator is on a row, that row gets deleted, and the loop essentially skips the next row.
Next, you are looking for a Match in column F of x, which contains a value from Column F. So, it will always return a value (itself, at the very minimum). Maybe try using a COUNTIF and seeing if it's greater than 1 may be a better option?
Next, you populated the variable x with the value in Cells(i, 6), but then you try to use it as a range when deleting. Change your code to the following and see if it works:
For i = Range("f" & Rows.Count).End(xlUp).Row To 1 Step -1
If Cells(i, 5).Value = "" Then 'if column E is blank on row i
x = Cells(i, 6).Value
If Application.Countif(Columns(6), x) > 1 Then '& if that row is a duplicate
ActiveSheet.Rows(i).Delete 'delete new duplicate row
End If
End If
Next i
Why not use the .RemoveDuplicates method? It's faster than looping around. Here's a rough outline on its use:
With Range
.RemoveDuplicates Columns:=Array(6), Header:=xlYes
End With
Here's the msdn doc for the method, and another page with a more detailed implementation. They should clear up any questions you might have.
I have multiple rows of single string data on sheet1 that I have used the MID formula to separate into multiple columns on sheet2; if I add new rows of string data to sheet1, how can I automate the same MID formula to be added to each column for each added row?
Here is an example of what these two sheets currently look like:
[sheet1] - string data
1239876010407201520.00
4566543010407201550.00
7893210010407201560.00
sheet2
Number User Type Date Amount
123 9876 1 4/7/2015 $20.00
456 6543 1 4/7/2015 $50.00
789 3210 1 4/7/2015 $60.00
If I add a row of string data to sheet1 how can I have Excel automatically add a row and apply the same MID formula to each table column on sheet2?
Right-click the Sheet1's name tab and choose View Code. When the VBE opens up, paste the following into the code sheet titled something like Book1 - Sheet1 (Code),
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Columns(1)) Is Nothing Then
On Error GoTo Safe_Exit
Application.EnableEvents = False
Dim rng As Range, str As String, rw As Long
For Each rng In Intersect(Target, Columns(1))
str = rng.Value
If Len(str) >= 18 Then
With Sheet2 'using sheet codename in case it gets reordered or renamed
rw = .Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
.Cells(rw, 1) = Left(str, 3)
.Cells(rw, 2) = Mid(str, 4, 4)
.Cells(rw, 3) = Mid(str, 8, 2)
.Cells(rw, 4) = DateSerial(Mid(str, 14, 4), Mid(str, 10, 2), Mid(str, 12, 2))
.Cells(rw, 5) = CCur(Mid(str, 18, 99))
End With
End If
Next rng
End If
Safe_Exit:
Application.EnableEvents = True
End Sub
Tap Alt+Q to return to your worksheet. Any values typed or pasted into column A will be stripped and split down to 5 values and populated into Sheet2's first available row in columns A:E. I've set a minimum length of 18 characters before it will attempt processing. This length amounts to a single digit being supplied for the amount off the right-hand end after the year.
You could wrap your mid formula in an iferror formula and set it to blank if it is an error, then just drag it down a bunch of rows and where there is data it will resolve, where there is not it will simply be blank giving the impression there is nothing there.
If you post your original mid formula I will give you an example, it may be prudent to test the cell rather than using iferror as iferror will trap genuine errors.
I have a table of data in Excel 2010 starting from row 10, each row containing a calculated number (X) in column I. The code is intended to insert (X) number of new rows below any row in the table when (X) is more than 1.
The current code achieves this, but as new entries are made into the table and I run the code again, more blank rows are added below the additional rows already inserted.
I'd also like to copy the information in columns A:G from the row containing (X) to each of the newly inserted rows, and make the original row appear in bold text.
Sub Insert_SB()
Dim lngCounter As Long
For lngCounter = Range("I" & Rows.count).End(xlUp).row To 10 Step -1
With Cells(lngCounter, "I")
If IsNumeric(.Value) And .Value > 1 Then
With .Offset(1, 0).Resize(.Value - 1, 1)
.EntireRow.Insert
End With
If IsNumeric(.Value) And .Value = 0 Then Exit For
End If
End With
Next lngCounter
End Sub
Your code will insert, say 5 blank rows beneath then number 5 in cell I11 for example. When you run the code again, it will again find the number 5 and insert another 5 rows.... You will need to tell it that it doesn't need to. That is to say you will need to either count the blank rows beneath the number 5 first, to see if there are already 5, or you need to mark the 5 as "done" (maybe by writing to column K perhaps)
This function could potentially tell you if you need to add rows:
Function NeedsMoreRows(rngToCheck As Range) As Boolean
Dim intNumBlankRows As Integer
Dim intCounter As Integer
'this is the number of blank rows it should have underneath it
intNumBlankRows = rngToCheck.Value
For intCounter = 1 To intNumBlankRows
If ActiveSheet.Cells(rngToCheck.Row + intCounter, rngToCheck.Column) <> vbNullString Then NeedsMoreRows = True
Next intCounter
End Function
If IsNumeric(.Value) And .Value > 1 And NeedsMoreRows(Cells(lngCounter, "A")) Then
I have a spreadsheet which I am cleaning and using macros to help. My column 'C' has temperature data. Like with all data, there is some missing. How would I write a macro that would auto-fill the missing spot with previous data?
For example:
C C
1 37 1 37
2 35 2 35
3 --------> 3 35
4 37 4 37
5 36 5 36
The spot C3 has been filled with C2's data.
Thank you for your help.
Do you really need VBA for this?
Do this
Select Col C
Press Ctrl + G
Click on Special
Next Click on Blanks
Click Ok
All Empty cells are now selected. Press the = key and then the Up arrow key
Lastly press Ctrl+Tab+Enter and you are done.
ScreenShot
Give this a try:
Sub FixC()
Dim N As Long, i As Long
N = Cells(Rows.Count, "C").End(xlUp).Row
For i = 2 To N
If Cells(i, "C") = "" Then
Cells(i, "C") = Cells(i - 1, "C")
End If
Next i
End Sub
How would I write that macro:
This contains only snippets.
loop over all cells in the column:
for each cell in ActiveSheet.Columns(1).Cells
if the cell value is not empty -> save the value to a variable
If cell.value <> Empty then lastCellValue = cell.value
if the cell value is empty -> write the saved cell value into the cell
Else cell.value = lastCellValue
also:
if more than x (e.g. 20) cells in a row were empty, break from loop