I have Sheet 1 (Column A ) value and Sheet 2 (Column A). I want to compare sheet 1 column A with sheet 2 Column A. If Sheet 1 (Column A) is found in the Sheet 2 then Delete the entire row in the Sheet 1. go to next one.
I have been stuck on this. Below is my Code. Its not working. Its keep getting wrong cell values
Sub Compare()
Dim i As Long
Dim j As Long
Dim lastRow_Task As Long
Dim lastRow_Compare As Long
Dim lastRow As Long
'Sheet 1
Dim Task As Worksheet
'Sheet 2
Dim Compare As Worksheet
Set Task = Excel.Worksheets("TaskDetails")
Set Compare = Excel.Worksheets("Compare")
Application.ScreenUpdating = False
lastRow_Task = Log.Cells(Rows.count, "A").End(xlUp).Row
lastRow_Compare = Compare.Cells(Rows.count, "A").End(xlUp).Row
For i = 2 To lastRow_Task
For j = 2 To lastRow_Compare
If Task.Cells(i, "A").Value = Compare.Cells(j, "A").Value Then
Compare.Cells(j, "A").ClearContents
End If
Next j
Next i
Using Match() is fast and will avoid the nested loop.
Also - when deleting rows it's best to work from the bottom to the top so the deleted rows don't interfere with your loop counter.
Sub Compare()
Dim i As Long
Dim lastRow_Task As Long
Dim Task As Worksheet 'Sheet 1
Dim Compare As Worksheet 'Sheet 2
Set Task = ActiveWorkbook.Worksheets("TaskDetails")
Set Compare = ActiveWorkbook.Worksheets("Compare")
Application.ScreenUpdating = False
lastRow_Task = Task.Cells(Task.Rows.Count, "A").End(xlUp).Row
For i = lastRow_Task To 2 Step -1
If Not IsError(Application.Match(Task.Cells(i, 1).Value, Compare.Columns(1), 0)) Then
Task.Rows(i).Delete
End If
Next i
Application.ScreenUpdating = True
End Sub
Related
I am trying to number column A in increments by 1, based on how many rows are in column B Example of my Excel sheet
The code I currently have does this, but the top number does not end up being 1. I need to start with 1 at the top and count down.
Sub SecondsNumbering()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Data Formatted")
Dim LastRow As Long
Dim i As Long
With ws
LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
For i = 6 To LastRow
.Cells(i, 1).Value = i - 1
Next
End With
End Sub
With this, I am counting the number of rows in the column.
Edit: When I do the value 7 for i, so that it starts at 6 (which is where I want data to start) this is what I get.
How about...
Option Explicit
Sub Test()
Dim lCntr As Long
lCntr = 6
Do
If (Cells(lCntr, 2) <> "") Then Cells(lCntr, 1) = lCntr - 5
lCntr = lCntr + 1
Loop Until Cells(lCntr, 2) = ""
End Sub
HTH
My code loops through rows and columns and performs an action. I want to loop to the first empty column, however,
my code keeps looping past this column. My sheet currently looks something like this:
A----------1----------blank---------A---------1
B----------2----------blank---------C---------4
C----------3----------blank---------W---------2
In the above example, I want to loop from k = 1 to the first empty column, which is k = 3 (i.e. only extract data from the first 2 columns then stop the loop).
This is my current code:
Option Explicit
Sub exitemptycolumn()
Dim lastcolumn As Long
Dim lastrow As Long
Dim sh As Worksheet
Dim rng As Range
Set sh = Sheets("sheetname")
lastcolumn = sh.Cells(1, Cells.Columns.Count).End(xlToLeft).Column
lastrow = sh.Cells(Rows.Count, 1).End(xlUp).Row
For k = 7 to lastcolumn
for j = 1 TO lastrow
set rng = sh.Range(columns(1), Columns(k))
If Application.WorksheetFunction.CountA(sh.Cells(1, k).EntireColumn) = 0 then Exit For
'rest of code
Next j
Next k
End Sub
To answer the question, you want to end your loop through columns as soon as the column is completely empty.
We can use Application.WorksheetFunction.CountA to do the check like so:
For k = 7 to lastcolumn
set rng = sh.Range(columns(1), Columns(k))
If Application.WorksheetFunction.CountA(sh.Cells(1, k).EntireColumn) = 0 then Exit For
Next k
Everything in this code works well until the piece where I need to delete the rows in column "I" of the source tab ("Status Report"). I have to run this macro several times to clear out all of the rows I want to delete because it appears to only delete one row at a time.
How can I get this macro to delete all of the rows I want and only run this code once?
Sub CopyYes()
Dim c As Range
Dim j As Integer
Dim Source As Worksheet
Dim Target As Worksheet
' Change worksheet designations as needed
Set Source = ActiveWorkbook.Worksheets("Status Report")
Set Target = ActiveWorkbook.Worksheets("Sheet1")
j = 1 ' Start copying to row 1 in target sheet
For Each c In Source.Range("I1:I1000") ' Do 1000 rows
If c = 1 Then
Source.Rows(c.Row).Copy Target.Rows(j)
j = j + 1
Source.Rows(c.Row).EntireRow.Delete
End If
Next c
End Sub
Thanks for your help!
How is this? It, as suggested by #yass, starts at the last row and works backwards.
Sub CopyYes()
Dim c As Range
Dim j As Integer
Dim Source As Worksheet
Dim Target As Worksheet
Dim lastRow As Long
' Change worksheet designations as needed
Set Source = ActiveWorkbook.Worksheets("Status Report")
Set Target = ActiveWorkbook.Worksheets("Sheet1")
blankRow = Target.Cells(Target.Rows.Count, 1).End(xlUp).Row ' Start copying to row 1 in target sheet
lastRow = 1000
' lastRow = Source.Cells(Source.Rows.Count, 9).End(xlUp).Row ' Uncomment this line if you want to do ALL rows in column I
With Source
For i = lastRow To 1 Step -1
If .Cells(i, 9).Value = 1 Then
If blankRow = 1 Then
.Rows(i).Copy Target.Rows(blankRow)
Else
.Rows(i).Copy Target.Rows(blankRow + 1)
End If
blankRow = Target.Cells(Target.Rows.Count, 1).End(xlUp).Row
.Rows(i).EntireRow.Delete
Next i
End With
End Sub
Note: The main difference is the For loop. AFAIK you can't do a For each x in Range loop backwards.
I have a workbook of ten sheets. In sheet 1, I want to list out sheet names (sheets 3 thru 10), column heading values in the sheet (columns 8 and beyond only) and for that column the number of cells that have data in it.
My code works for two of these three requirements. On my sheet 1 (named: SheetName Columns) I get the Sheet Names in column A and Column Heading in column B, however not having any luck getting that sheet/columns number of data rows.
On my sheet 1, column A gets duplicated per number of columns after column 7 on that sheet and that is fine.
Sub ListColumnHeadings()
Dim cNbrs As Long, i As Integer, tr As Long, tc As Long, wst As Worksheet
Dim charList(300, 300) As String
Dim ws As Worksheet, OutputRow As Long
Dim myRange As Range
Dim NumRows As Integer
Dim colNbr As Range
Set shSkip1 = ThisWorkbook.Sheets("SheetName Record Cnt")
Set shList = ThisWorkbook.Sheets("SheetName Columns")
OutputRow = 1
On Error Resume Next
For Each ws In Worksheets
If ws.Name <> shList.Name And ws.Name <> shSkip1.Name Then
cNbrs = ws.Range("A1").CurrentRegion.Columns.Count
For i = 8 To cNbrs
shList.Cells(OutputRow, "A").Value = ws.Name
shList.Cells(OutputRow, "B").Value = ws.Cells(1, i)
Set myRange = ws.Columns(i).Select
NumRows = ws.Application.WorksheetFunction.CountA(myRange)
If NumRows > 0 Then
shList.Cells(OutputRow, "C").Value = NumRows
End If
OutputRow = OutputRow + 1
Next i
End If
Next ws
End Sub
It's because of your use of Set myRange... You don't need to .Select it. Just change that line to Set myRange = ws.Columns(i)
If you want to leave .Select, then the next line should be
NumRows = ws.application.worksheetfunction.counta(selection), but it is highly recommended you avoid using .Select, this is just for your info.
This is my first attempt at VBA, so I apologize for my ignorance. The situation is as follows: I have a spreadsheet that consists of 4 columns and 629 rows. When I am trying to do is iterate through the 4 cells in each row and check for a blank cell. If there is a row that contains a blank cell, I want to cut it from Sheet1 and paste it into the first available row in Sheet2.
(Ideally the number of columns AND the number of rows is dynamic based on each spreadsheet, but I have no idea how to iterate through rows and columns dynamically)
Sub Macro1()
'
' Macro1 Macro
' Move lines containing empty cells to sheet 2
'
' Keyboard Shortcut: Ctrl+r
'
Dim Continue As Boolean
Dim FirstRow As Long
Dim CurrentRow As Long
Dim LastRow As Long
Dim EmptySheetCount As Long
Dim Counter As Integer
'Initialize Variables
LContinue = True
FirstRow = 2
CurrentRow = FirstRow
LastRow = 629
EmptySheetCount = 1
'Sheets(Sheet1).Select
'Iterate through cells in each row until an empty one is found
While (CurrentRow <= LastRow)
For Counter = 1 To 4
If Sheet1.Cells(CurrentRow, Counter).Value = "" Then
Sheet1.Cells(CurrentRow).EntireRow.Cut Sheet2.Cells(EmptySheetCount, "A")
EmptySheetCount = EmptySheetCount + 1
Counter = 1
CurrentRow = CurrentRow + 1
GoTo BREAK
Else
Counter = Counter + 1
End If
Counter = 1
BREAK:
Next
Wend
End Sub
When I run it, I typically get an error around the Sheet1.Cells(CurrentRow, Counter).Value = "" area, so I know I'm referencing sheets incorrectly. I've tried Sheets(Sheet1), Worksheets("Sheet1") and nothing seems to be working. When I do change to Worksheets("Sheet1"), however, it runs and just freezes Excel.
I know I'm doing multiple things wrong, I just know way too little to know what.
Thanks a lot in advance. And sorry for the crap formatting.
There are a few things wrong with your code so rather than go through them individually here is a basic looping version that does what you're after.
Sub moveData()
Dim wksData As Worksheet
Dim wksDestination As Worksheet
Dim lastColumn As Integer
Dim lastRow As Integer
Dim destinationRow As Integer
Set wksData = Worksheets("Sheet1")
Set wksDestination = Worksheets("Sheet2")
destinationRow = 1
lastColumn = wksData.Range("XFD1").End(xlToLeft).Column
lastRow = wksData.Range("A1048576").End(xlUp).Row
For i = lastRow To 1 Step -1 'go 'up' the worksheet to handle 'deletes'
For j = 1 To lastColumn
If wksData.Cells(i, j).Value = "" Then 'check for a blank cell in the current row
'if there is a blank, cut the row
wksData.Activate
wksData.Range(Cells(i, 1), Cells(i, lastColumn)).Cut
wksDestination.Activate
wksDestination.Range(Cells(destinationRow, 1), Cells(destinationRow, lastColumn)).Select
ActiveSheet.Paste
'If required this code will delete the 'cut' row
wksData.Rows(i).Delete shift:=xlUp
'increment the output row
destinationRow = destinationRow + 1
Exit For 'no need to carry on with this loop as a blank was already found
End If
Next j
Next i
set wksData = Nothing
set wksDestination = Nothing
End Sub
There are other ways that will achieve the same outcome but this should give you and idea of how to use loops, sheets, ranges, etc.
The lastColumn and lastRow variables will find the the last column/row of data in the given columns/rows (i.e, in my code it finds the last column of data in row 1, and the last row of data in column A).
Also, you should get into the habit of debugging and stepping through code to identify errors and see exactly what each line is doing (this will also help you learn too).
You might find this of use.
It uses an array variable to store the values of the cells in the row to be moved. It does not use cut and paste, so only transfer the data values, and the code does not require activation of the required sheets.
The destination rows are in the same order as the rows on the original sheet.
The method used to find the last cell used in the row and column is more elegant than other answers given.
Option Explicit
Public Sub test_moveData()
Dim wksData As Worksheet
Dim wksDestination As Worksheet
Set wksData = shtSheet1 ' Use the Codename "shtSheet1" for the worksheet. ie the value of the sheet property that is displayed as "(Name)"
Set wksDestination = shtSheet2
moveData wksData, wksDestination
End Sub
Public Sub moveData(wksData As Worksheet, wksDestination As Worksheet)
Dim ilastColumn As Integer
Dim ilastRow As Integer
Dim iRow As Long
Dim iColumn As Long
Dim iDestinationRowNumber As Integer
Dim MyArray() As Variant
Dim rngRowsToDelete As Range
iDestinationRowNumber = 1
ilastColumn = wksData.Cells(1, wksData.Columns.Count).End(xlToLeft).Column
ilastRow = wksData.Cells(wksData.Rows.Count, 1).End(xlUp).Row
ReDim MyArray(1, ilastColumn)
Set rngRowsToDelete = Nothing
For iRow = 1 To ilastRow Step 1 'No need to go 'up' the worksheet to handle 'deletes'
For iColumn = 1 To ilastColumn
If wksData.Cells(iRow, iColumn).Value = "" Then 'check for a blank cell in the current row
MyArray = wksData.Range(wksData.Cells(iRow, 1), wksData.Cells(iRow, ilastColumn)).Value
wksDestination.Range(wksDestination.Cells(iDestinationRowNumber, 1),
wksDestination.Cells(iDestinationRowNumber, ilastColumn) _
).Value = MyArray
'Store the rows to be deleted
If rngRowsToDelete Is Nothing Then
Set rngRowsToDelete = wksData.Rows(iRow)
Else
Set rngRowsToDelete = Union(rngRowsToDelete, wksData.Rows(iRow))
End If
'increment the output row
iDestinationRowNumber = iDestinationRowNumber + 1
Exit For 'no need to carry on with this loop as a blank was already found
End If
Next iColumn
Next iRow
If Not rngRowsToDelete Is Nothing Then
rngRowsToDelete.EntireRow.Delete shift:=xlUp
End If
Set rngRowsToDelete = Nothing
Set wksData = Nothing
Set wksDestination = Nothing
End Sub
' enjoy