in the range A1 to A70, if a cell is empty/blank then delete that entire row and move the other rows underneath up
Thank you
Use following codes.
Sub RemoveDuplicate()
On Error Resume Next
Range("A1:A70").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub
Edit:
Sub RemoveBlankRowsInARange()
Dim rng As Range, rws As Long, i As Long
Dim LastRow As Long
' LastRow = Cells(Rows.Count, "A").End(xlUp).Row
' Set rng = ActiveSheet.Range("A2:A" & LastRow)
' rws = rng.Rows.Count
'
' For i = rws To 1 Step (-1)
For i = 100 To 1 Step (-1)
If WorksheetFunction.CountA(Rows(i)) = 0 Then Rows(i).EntireRow.Delete
Next
End Sub
#Harun24HR - Here's how I attempted at solving this problem: I recorded a macro that deletes a row and I edited that macro to do my original question, why doesn't this work, please correct it:
Sub DeleteRowWithEmptyCell()
Dim row As Integer
For row = 1 To 100 'or whatever numbers needed
If Cells(row, 1).Value() = "" Then
Rows("row:row").Select
Selection.Delete Shift:=xlUp
End If
Next row
End Sub
Related
I am trying to have a macro to run through a column of data and insert a row for every instance it counts a "," so for example it would insert another 3 rows above Joanne
I currently have this code below but it doesn't work and im not sure im on the right track for it as I think it is looking for "," to only be the only contents in the cell? Any help/guidance would be greatly appreciated.
Sub InsertRow()
Dim cell As Range
For Each cell In Range("E2:E9999")
If cell.Value = "," Then
cell.EntireRow.Insert
End If
Next cell
End Sub
Insert As Many Rows As There Are Commas
Option Explicit
Sub InsertCommaRows()
Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
Dim lRow As Long: lRow = ws.Cells(ws.Rows.Count, "E").End(xlUp).Row
Application.ScreenUpdating = False
Dim cString As String
Dim CommasCount As Long
Dim r As Long
For r = lRow - 1 To 2 Step -1
Debug.Print ws.Cells(r, "E").Address(0, 0)
cString = CStr(ws.Cells(r, "E").Value)
CommasCount = Len(cString) - Len(Replace(cString, ",", ""))
If CommasCount > 0 Then
ws.Cells(r + 1, "E").Resize(CommasCount).EntireRow _
.Insert xlShiftDown, xlFormatFromLeftOrAbove
End If
Next r
Application.ScreenUpdating = True
MsgBox "Comma-rows inserted.", vbInformation
End Sub
This code counts the commas then inserts the same number of rows immediately below the current cell.
Sub InsertRow()
Dim cell As Range
Dim iCommas As Integer
For Each cell In ActiveSheet.Range("E2:E9999")
iCommas = Len(cell.Value) - Len(Replace(cell.Value, ",", ""))
If iCommas > 0 Then
cell.Offset(1).Resize(iCommas).EntireRow.Insert xlDown
End If
Next cell
End Sub
I'm trying to traverse each column in the same row, I'm new to VBA and any help would be appreciated..
Here's my code:
Sub dural()
Dim i As Long
Dim j As Long
i = 2
Cells(1, i).Select
For i = 2 To Columns.Count
Cells(1, i + j).Select
'Selection.Copy
j = i + 1
Next i
End Sub
Luan Yi,
Your question states "trying to traverse each column in the same row";
the code below shows how to loop through each Column, or loop through
each cell in Row 1 and use .EntireColumn to do something; without using .Select
'Use the With statement that meets your needs
'define your variables
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1") 'change worksheet name as needed
Dim lCol As Long: lCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column 'define last used column in row 1
For i = 2 To lCol
'If you want to loop through each column, you can use...
With ws.Columns(i)
'you can do something, for example using .Delete or .Copy, etc.
End With
'or
'If you want to loop through each cell in row 1, the you can use...
With ws.Cells(1, i)
'you can do something, for example using .EntireColumn.Delete or .EntireColumn.Copy, etc.
End With
Next i
Two questions:
1) I have a spreadsheet (TC) that has data on one page that will be updated daily. There are 28 columns. Essentially I am looking to have the line (row) data cut and paste into a second spreadsheet (Archive) when Col. 28 has a value entered in it. I have the base coding but for some reason it causes Excel to be non-responsive.
I think it might be because the coding goes cell by cell rather than row by row. Can anyone point me in the right direction? (Again, keep in mind, this is a snippet of the coding - I have each Cut and Paste up to Column 28.)
2) The second part of my question is: Will what I have written make sure that when the Command Button is pressed next time, the data will cut and paste to the next blank line. Thank you!
Private Sub CommandButton1_Click()
a = Worksheets("TC").Cells(Rows.Count, 2).End(xlUp).Row
'Dim rng As Range
'Set rng = Worksheets("Archived").Range("A1")
b = 1
For i = 2 To a
If Worksheets(“TC”).Cells(i, 28).Value <> "" Then
'Change # to be the number column of Pt Name
Worksheets(“TC”).Cells(i, 1).Cut
'Change ,# to be the number column of where you want it pasted.
Worksheets(“TC”).Paste Destination:=Worksheets(“Archive”).Cells(b + 1, 1)
'Change ,# to be the number column of SOC
Worksheets(“TC”).Cells(i, 2).Cut
'Change ,# to be the number column of where you want it pasted.
Worksheets(“TC”).Paste Destination:=Worksheets(“Archive”).Cells(b + 1, 2)
b = b + 1
End If
Next
Application.CutCopyMode = False
ThisWorkbook.Worksheets(“TC”).Cells(1, 1).Select
End Sub
You can do something like this:
Private Sub CommandButton1_Click()
Dim i as long, b As Long, shtTC as worksheet, shtArch as worksheet
Set shtTC = Worksheets("TC")
Set shtArch = Worksheets("Archive")
'find the first empty row
b = shtArch.Cells(Rows.Count, 2).End(xlUp).Row + 1 'pick a column which will always be populated
For i = 2 To shtTC.Cells(Rows.Count, 2).End(xlUp).Row
If shtTC.Cells(i, 28).Value <> "" Then
'cut the row
shtTc.Cells(i, 1).Resize(1, 28).Cut shtArch.Cells(b, 1)
b = b + 1
End If
Next
Application.CutCopyMode = False
shtTC.Cells(1, 1).Select
End Sub
Here's an example of how to create the kind of copy results you're looking for. Notice that, unless you specifically want to copy/paste all of the formatting with the data, you don't need to use copy/paste. You can perform the copy by assigning the values of the ranges.
Option Explicit
Private Sub CommandButton1_Click()
CopyData ThisWorkbook.Sheets("TC"), ThisWorkbook.Sheets("Archived")
End Sub
Public Sub CopyData(ByRef source As Worksheet, _
ByRef dest As Worksheet, _
Optional ByVal deleteSource As Boolean = False)
'--- calculate and create the source data range
Const TOTAL_COLUMNS As Long = 1
Dim srcRange As Range
Dim lastRow As Long
With source
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
Set srcRange = .Range("A1").Resize(lastRow, TOTAL_COLUMNS)
End With
'--- determine where the data should go
Dim destRange As Range
With dest
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
If lastRow > 1 Then lastRow = lastRow + 1
Set destRange = .Cells(lastRow, 1)
Set destRange = destRange.Resize(srcRange.Rows.Count, TOTAL_COLUMNS)
End With
'--- now copy the data
destRange.Value = srcRange.Value
'--- optionally delete the source data
If deleteSource Then
srcRange.Clear
End If
End Sub
In my column A I have cells which consists of formatted dates and general formatting. I want to delete rows which are not dates, and I've made this code, but I have to run it multiple times to get it to delete all the rows which aren't dates.
Code:
Sub del_row_not_date()
Dim rng_A_last As Long
Dim i As Integer
rng_A_last = Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row
Debug.Print rng_A_last
For i = 1 To rng_A_last Step 1
If IsDate(Sheet1.Cells(i, 1)) = False Then
Sheet1.Cells(i, 1).EntireRow.Delete
End If
Next
End Sub
Thanks in advance!
Since rows will
Based on this LINK I found this:
a tip about deleting rows based on a condition If you start at the top and work down, every time you delete a row your counter will effectively move to the cell two rows below the row you deleted because the row immediately below the deleted row moves up (i.e. it is not tested at all).
This works :)
Sub del_row_not_date()
Dim rng_A_last As Long
Dim i As Integer
rng_A_last = Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row
Debug.Print rng_A_last
For i = rng_A_last To 1 Step -1
'Debug.Print Cells(i, 1).Value
If IsDate(Sheet1.Cells(i, 1)) = False Then
Sheet1.Cells(i, 1).EntireRow.Delete
End If
Next
End Sub
you could try
Sub del_row_not_date()
With Sheet1
.Range("A1", .Cells(.Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeConstants, xlTextValues).EntireRow.Delete
End With
End Sub
what above deletes all column "A" not-numbers cells entire row
if you have cells with numbers that are not dates then use:
Option Explicit
Sub del_row_not_date()
Dim i As Integer
With Sheet1
For i = .Cells(.Rows.Count, "A").End(xlUp).Row To 1 Step -1 '<--| loop backwards not to loose next row index after deleting the current one
If Not IsDate(.Cells(i, 1)) Then .Cells(i, 1).EntireRow.Delete
Next i
End With
End Sub
I have a vba code that copies rows on a sheet to another sheet depending if column A = 1 and it works perfectly. I am trying to make it paste to the next available row instead of overwriting the data that is already there in order to make a log. Here is the code I have already but I can't seem to figure out how to make it paste to the next available row. Any help would be greatly appreciated! Thanks in advance!
Sub Log()
Dim rng As Range
Dim lastRow As Long
Dim cell As Variant
Dim count As Long
count = 0
With ActiveSheet
lastRow = .Range("A" & .Rows.count).End(xlUp).Row
Set rng = .Range("A3:A" & lastRow)
For Each cell In rng
If cell.Value = "1" Then
Range(cell.Offset(0, 1), cell.Offset(0, 6)).Copy
Range("'Log'!B3").Offset(count, 0).PasteSpecial xlPasteValues
count = count + 1
End If
Next
End With
End Sub
You just need to loop through the source sheet.
Try using .Cells(row,col) instead of Range..
This example is heavy on the comments to help understand the looping process.
You will need a few additional Functions to make this work using this code.
LastRow Function
Function lastRow(sheet As String) As Long
lastRow = Sheets(sheet).Cells(Rows.Count, "A").End(xlUp).Row 'Using Cells()
End Function
LastCol Function
Function lastCol(sheet As String) As Long
lastCol = Sheets(sheet).Cells(2, Columns.Count).End(xlToLeft).Column
End Function
Code for solution: Assuming you have your target sheet's headers already set up AND the target and source sheet share the same formatting.
Sub Log()
Dim source As String, target As String
Dim sRow As Long, col As Long, tRow As Long
'Declare Sheets
source = "Sheet1"
target = "Sheet2"
'Loop through rows of source sheet
For sRow = 2 To lastRow(source)
'Get current last row of Target Sheet
tRow = lastRow(target) + 1
'Meet criteria for Column A to = 1 on Source
If Sheets(source).Cells(sRow, 1) = "1" Then
'Copy each column of source sheet to target sheet in same order
For col = 1 To lastCol(source)
Sheets(target).Cells(tRow, col) = Sheets(source).Cells(sRow, col)
Next col
End If
Next sRow
End Sub