The point of this code is to take user inputs from a "Remove Flags" tab in which the user puts an item number and what program it belongs to, filters the "Master List" tab by the item number and the program, then match the name of the flag to the column and delete the flag. However the offset is not working. It is instead deleting the header. When I step through it everything works fine until the line I marked with '*******.
I am fairly new to VBA and am self taught so any and all help is greatly appreciated. Thank you very much for your time.
EDIT: Removed "On Error Resume Next" and fixed some spelling errors. Current issue is with rng not having >1 rows when it is filtered and definitely has two rows (one row is the header, one row is the returned data.)
Sub RemoveFlag()
Dim cel As Range
Dim rg As Range
Dim d As Double
Dim i As Integer
Dim m As Integer
Dim n As Integer
Dim rng As Range
Dim wsMaster As Worksheet
Dim wsFlag As Worksheet
Set wsMaster = Worksheets("Master List")
Set wsFlag = Worksheets("Remove Flags")
i = 6
'If there is no data. Do nothing.
If wsFlag.Range("C6") = "" Then
wsFlag.Activate
Else
Application.ScreenUpdating = False
'Add Leading zeroes
wsFlag.Activate
Set rg = Range("C6")
Set rg = Range(rg, rg.Worksheet.Cells(Rows.Count, rg.Column).End(xlUp))
rg.NumberFormat = "#"
For Each cel In rg.Cells
If IsNumeric(cel.Value) Then
d = Val(cel.Value)
cel.Value = Format(d, "000000000000000000") 'Eighteen digit number
End If
Next
'Clear all the filters on the Master List tab.
wsMaster.Activate
If wsMaster.AutoFilterMode = True Then
wsMaster.AutoFilterMode = False
End If
'Loop through all lines of data
Do While wsFlag.Cells(i, 3).Value <> ""
'Filter by the SKU number
wsMaster.Range("A1").AutoFilter Field:=4, Criteria1:=wsFlag.Cells(i, 3).Value
'Filter by the Program
wsMaster.Range("A1").AutoFilter Field:=2, Criteria1:=wsFlag.Cells(i, 2).Value
'If the filter is not empty find the column of the flag
Set rng = wsMaster.UsedRange.SpecialCells(xlCellTypeVisible)
If (rng.Rows.Count > 1) Then
wsMaster.Range("A1:Z1").Find(wsFlag.Cells(i, 4), LookIn:=xlValues).Activate
n = ActiveCell.Column
Sheets("Master List").Range.Offset(1, 0).SpecialCells(xlCellTypeVisible).Select
m = ActiveCell.Row
Cells(m, n) = ""
wsFlag.Activate
wsFlag.Range(Cells(i, 2), Cells(i, 4)).ClearContents
Else
wsFlag.Activate
wsFlag.Range(Cells(i, 2), Cells(i, 4)).Copy
wsFlag.Range("F4").End(xlDown).Offset(1, 0).Activate
ActiveCell.PasteSpecial Paste:=xlPasteValues
wsFlag.Range(Cells(i, 2), Cells(i, 4)).ClearContents
End If
wsMaster.Activate
wsMaster.AutoFilterMode = False
i = i + 1
Loop
'Make sure the entire Master List tab is not highlighted and pull the 'highlighted cell' to A1 in both tabs.
wsMaster.Activate
wsMaster.Range("A1").Activate
wsFlag.Activate
Range("A1").Activate
'Unfreeze the screen
Application.ScreenUpdating = True
End If
End Sub
As #Zerk suggested, first set two Worksheet variables at top of code:
Dim wsMaster As Worksheet
Dim wsRemoveFlags As Worksheet
Set wsMaster = Worksheets("Master List")
Set wsRemoveFlags = Worksheets("Remove Flags")
Then replace all other instances of Worksheets("Master List") with wsMaster and Worksheets("Remove Flags") with wsRemoveFlags.
Sometimes it's easier to just loop through your rows and columns. Something like the following:
Replace everything between:
Do While wsFlag.Cells(i, 3).Value <> ""
...
Loop
with:
Do While wsFlag.Cells(i, 3).Value <> ""
Dim r As Long ' Rows
Dim c As Long ' Columns
Dim lastRow As Long
Dim found As Boolean
lastRow = wsMaster.Cells.SpecialCells(xlLastCell).Row
found = False
For r = 2 To lastRow ' Skipping Header Row
' Find Matching Program/SKU
If wsMaster.Cells(r, 2).Value = wsFlag.Cells(i, 2).Value _
And wsMaster.Cells(r, 3) = wsFlag.Cells(i, 3).Value Then
' Find Flag in Row
For c = 1 To 26 ' Columns A to Z
If wsMaster.Cells(r, c) = wsFlag.Cells(i, 4) Then
' Found Flag
wsMaster.Cells(r, c) = ""
found = True
Exit For ' if flag can be in more than one column, remove this.
End If
Next 'c
End If
Next 'r
If Not found Then
' Here is where you need to put code if Flag wsFlag.Cells(i, 4) not found.
End If
Loop
Related
I am aiming to lock entire rows where the word "Done" appears in a specific column. My code below achieves what I seek but it takes 18 seconds to compute (too long). Is there a faster/more efficient coding alternative?
There is an existing question on StackOverflow similar to this (found here) but my data does not exist in defined tables (this won't change), so I don't know how to adapt the suggestion there.
Private Sub Lock_Rows(ByVal Target As Range)
Dim DestSh As Worksheet
Dim lastrow As Long
Dim i As Long ' Integer
Set DestSh = Worksheets(8) 'Data tab for Item 1
With DestSh
'finds the last row with data on B column, B column has dates
lastrow = .Range("B" & .Rows.Count).End(xlUp).Row
'parse all rows
For i = 26 To lastrow 'rows of data begin at row 26
'if your conditions are met
If .Cells(i, "Z").Value = "Done" Then
.Cells(i, "Z").EntireRow.Cells.Locked = True 'lock the row
Else
.Cells(i, "Z").EntireRow.Cells.Locked = False 'leave rows unlocked
End If
Next i
.Protect UserInterfaceOnly:=True
End With
Set DestSh = Nothing
End Sub
The Lock / Unlock operations om individual rows are quite slow. Better to build a range reference to Lock / Unlock and do that operation in on go at the end.
Something like
Private Sub Lock_Rows(ByVal Target As Range)
Dim DestSh As Worksheet
Dim lastrow As Long
Dim i As Long ' Integer
Dim rLock As Range, rUnlock As Range
Set DestSh = Worksheets(8) 'Data tab for Item 1
With DestSh
'finds the last row with data on B column, B column has dates
lastrow = .Range("B" & .Rows.Count).End(xlUp).Row
'parse all rows
For i = 26 To lastrow 'rows of data begin at row 26
'if your conditions are met
If .Cells(i, "Z").Value = "Done" Then
If rLock Is Nothing Then
Set rLock = .Cells(i, "Z").EntireRow
Else
Set rLock = Application.Union(rLock, .Cells(i, "Z").EntireRow)
End If
Else
If rUnlock Is Nothing Then
Set rUnlock = .Cells(i, "Z").EntireRow
Else
Set rUnlock = Application.Union(rUnlock, .Cells(i, "Z").EntireRow)
End If
End If
Next i
If Not rLock Is Nothing Then rLock.Locked = True
If Not rUnlock Is Nothing Then rUnlock.Locked = False
.Protect UserInterfaceOnly:=True
End With
Set DestSh = Nothing
End Sub
It will be faster still you could incorporate use of Variant Arrays on the loop
On my hardware it takes about 6 s to process 500,000 rows
Try with this solution which seems to be much faster than original one:
Private Sub Lock_Rows_new(ByVal Target As Range)
Debug.Print "s:" & Timer
Dim DestSh As Worksheet
Dim lastrow As Long
Dim i As Long ' Integer
Set DestSh = Worksheets(8) 'Data tab for Item 1
With DestSh
'range to search
Dim firstRNGRow As Variant '!! important
firstRNGRow = 26
Dim firstRNG As Range
Set firstRNG = .Cells(firstRNGRow, "Z")
Dim lastRNG As Range
Set lastRNG = .Cells(.Range("B" & .Rows.Count).End(xlUp).Row, "Z")
'unlock all
Range(firstRNG, lastRNG).EntireRow.Cells.Locked = False
'search for first done
firstRNGRow = Application.Match("Done", Range(firstRNG, lastRNG), 0)
Do While (Not IsError(firstRNGRow))
Set firstRNG = .Cells(firstRNG.Row + firstRNGRow, "Z")
firstRNG.Offset(-1, 0).EntireRow.Cells.Locked = True 'lock the row
If firstRNG.Row > lastRNG.Row Then Exit Do
firstRNGRow = Application.Match("Done", Range(firstRNG, lastRNG), 0)
Loop
.Protect UserInterfaceOnly:=True
End With
Set DestSh = Nothing
Debug.Print "e:" & Timer
End Sub
Edited to add a faster solution combining Sort() and AutoFilter()
AutoFilter() can make things fast:
Private Sub Lock_Rows(ByVal Target As Range)
With Worksheets(8)
If IsEmpty(.Range("Z25")) Then .Range("Z25").Value = "xxx" ' be sure you have a column "header" for data in column Z from row 26 downwards
With .Range("Z25:Z" & .Cells(.Rows.Count, "B").End(xlUp).Row)
.EntireRow.Locked = False ' unlock all cells
.AutoFilter field:=1, Criteria1:="Done"
With Intersect(ActiveSheet.UsedRange, .EntireColumn).Resize(.Rows.Count - 1, .Columns.Count).Offset(1, 0)
If CBool(Application.Subtotal(103, .Cells)) Then .SpecialCells(xlCellTypeVisible).EntireRow.Locked = True ' lock only filtered range rows
End With
End With
If .Range("Z25").Value = "xxx" Then .Range("Z25").ClearContents ' remove any "not original" column header
End With
End Sub
if you know that cell Z25 content is always not empty then you can omit the lines:
If IsEmpty(.Range("Z25")) Then .Range("Z25").Value = "xxx"
If .Range("Z25").Value = "xxx" Then .Range("Z25").ClearContents
and if you Sort things, it's even faster:
Option Explicit
Private Sub Lock_Rows(ByVal Target As Range)
Dim dataRange As Range, sortRange As Range, lockRange As Range
With Worksheets("8") ' reference wanted sheet
Set dataRange = .Range("Z25", .Cells(.Rows.Count, "B").End(xlUp))
Set lockRange = Intersect(.Columns("Z"), dataRange)
Set sortRange = Intersect(dataRange.EntireRow, .UsedRange.Columns(.UsedRange.Columns.Count + 1)) ' reference the range in same rows as referenced one but in first "not used" column
Set dataRange = .Range(dataRange, sortRange)
End With
With sortRange
.Formula = "=ROW()" ' write rows indexes in referenced range. this will be used to sort things back
.Value = .Value ' get rid of formulas
End With
dataRange.Sort key1:=lockRange.Resize(1), order1:=xlAscending, Header:=xlYes ' sort data on columns with possible "Done" values
If IsEmpty(lockRange(1, 1)) Then lockRange(1, 1).Value = "xxx" ' remove any "not original" column header
With dataRange ' reference referenced sheet column B range in
.AutoFilter field:=lockRange.Column - Columns(1).Column, Criteria1:="Done"
With .Resize(.Rows.Count - 1, .Columns.Count).Offset(1, 0)
If CBool(Application.Subtotal(103, .Cells)) Then .SpecialCells(xlCellTypeVisible).EntireRow.Locked = True ' lock only filtered range rows
End With
.Parent.AutoFilterMode = False
.Sort key1:=sortRange.Resize(1), order1:=xlAscending, Header:=xlYes ' sort things back
sortRange.ClearContents ' delete rows index, not needed anymore
End With
If lockRange(1, 1).Value = "xxx" Then lockRange(1, 1).ClearContents ' remove any "not original" column header
End Sub
again, if you know that cell Z25 content is always not empty then you can omit the lines:
If IsEmpty(lockRange(1, 1)) Then lockRange(1, 1).Value = "xxx" ' remove any "not original" column header
If lockRange(1, 1).Value = "xxx" Then lockRange(1, 1).ClearContents ' remove any "not original" column header
I have written a macro to remove rows containing certain text in it. If either of the keyword contains any text, the macro will delete the row. However, the macro doesn't work at all. Perhaps, i did something wrong in it. Hope somebody will help me rectify this. Thanks in advance.
Here is what I'm trying with:
Sub customized_row_removal()
Dim i As Long
i = 2
Do Until Cells(i, 1).Value = ""
If Cells(i, 1).Value = "mth" Or "rtd" Or "npt" Then
Cells(i, 1).Select
Selection.EntireRow.Delete
End If
i = i + 1
Loop
End Sub
The keyword within the text I was searching in to delete:
AIRLINE DRIVE OWNER mth
A rtd REPAIRS INC
AANA MICHAEL B ET AL
ABASS OLADOKUN
ABBOTT npt P
AIRLINE AANA MTH
ABASS REPAIRS NPT
Try like this.
What about Using Lcase.
Sub customized_row_removal()
Dim rngDB As Range, rngU As Range, rng As Range
Dim Ws As Worksheet
Set Ws = Sheets(1)
With Ws
Set rngDB = .Range("a2", .Range("a" & Rows.Count))
End With
For Each rng In rngDB
If InStr(LCase(rng), "mth") Or InStr(LCase(rng), "rtd") Or InStr(LCase(rng), "npt") Then
If rngU Is Nothing Then
Set rngU = rng
Else
Set rngU = Union(rngU, rng)
End If
End If
Next rng
If rngU Is Nothing Then
Else
rngU.EntireRow.Delete
End If
End Sub
VBA syntax of your Or is wrong,
If Cells(i, 1).Value = "mth" Or "rtd" Or "npt" Then
Should be:
If Cells(i, 1).Value = "mth" Or Cells(i, 1).Value = "rtd" Or Cells(i, 1).Value = "npt" Then
However, you need to use a string function, like Instr or Like to see if a certain string is found within a longer string.
Code
Option Explicit
Sub customized_row_removal()
Dim WordsArr As Variant
Dim WordsEl As Variant
Dim i As Long, LastRow As Long
Dim Sht As Worksheet
WordsArr = Array("mth", "rtd", "npt")
Set Sht = Worksheets("Sheet1")
With Sht
' get last row in column "A"
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
For i = LastRow To 2 Step -1
For Each WordsEl In WordsArr
If LCase(.Cells(i, 1).Value) Like "*" & WordsEl & "*" Then
.Rows(i).Delete
End If
Next WordsEl
Next i
End With
End Sub
I try to make my code sample as I can if you have any question please ask
Private Sub remove_word_raw()
'PURPOSE: Clear out all cells that contain a specific word/phrase
Dim Rng As Range
Dim cell As Range
Dim ContainWord As String
'What range do you want to search?
Set Rng = Range("A2:A25")
'sub for the word
shorttext1 = "mth"
shorttext2 = "rtd"
shorttext3 = "npt"
'What phrase do you want to test for?
ContainWord1 = shorttext1
ContainWord2 = shorttext2
ContainWord3 = shorttext3
'Loop through each cell in range and test cell contents
For Each cell In Rng.Cells
If cell.Value2 = ContainWord1 Then cell.EntireRow.Delete
Next
For Each cell In Rng.Cells
If cell.Value2 = ContainWord2 Then cell.EntireRow.Delete
Next
For Each cell In Rng.Cells
If cell.Value2 = ContainWord3 Then cell.EntireRow.Delete
Next cell
End Sub
I'm writing a macro to sort through a large file of data at work. I've inserted a blank row at the top of different section of data. I want my code to realize when a row is blank in column C, then fill in a set of headers in that row. It should then continue to find the next blank in column C. This should continue until my code finds 2 consecutive blanks, which signals the end of my data.
Currently, my code inserts the desired headers, but only in the first row of my worksheet. I believe that I need to change the loop contained inside my "Do... Loop Until" function. I just can't seem to get the correct code to achieve my desired results.
I've included a screencapture of roughly what my spreadsheet will look like.
Any help or advice is greatly appreciated.
This is the code I have so far:
Sub AddHeaders()
'Add headers below each section title
Dim Headers() As Variant
Dim ws As Worksheet
Dim wb As Workbook
Dim LastRow As Long, Row As Long
Application.ScreenUpdating = False 'turn this off for the macro to run a
little faster
Set wb = ActiveWorkbook
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
ActiveCell = Cells(1, 3)
Headers() = Array("Item", "Configuration", "Drawing/Document Number",
"Title", "ECN", "Date", "Revisions")
' Set Do loop to stop when two consecutive empty cells are reached.
Do
For Row = 1 To LastRow 'Add a loop to go through the cells in each row?
If IsEmpty(ActiveCell) = True Then 'If row is empty, then go in and add headers
For i = LBound(Headers()) To UBound(Headers())
Cells(Row, 1 + i).Value = Headers(i)
Next i
Rows(Row).Font.Bold = True
'Loop here
End If
Next Row
ActiveCell = ActiveCell.Offset(1, 0)
Loop Until IsEmpty(ActiveCell) And IsEmpty(ActiveCell.Offset(1, 0))
Application.ScreenUpdating = True 'turn it back on
MsgBox ("Done!")
Is this what you are looking for?
I removed the activecell stuff and used range instead.
Also removed the do loop and only use the for loop.
I think it works but Not sure. It does not look like you have on your picture but I keept your text code.
Sub AddHeaders()
'Add headers below each section title
Dim Headers() As Variant
Dim ws As Worksheet
Dim wb As Workbook
Dim LastRow As Long, Row As Long
Application.ScreenUpdating = False 'turn this off for the macro to run a
Set wb = ActiveWorkbook
LastRow = Cells(Rows.Count, 3).End(xlUp).Row
ActiveCell = Cells(1, 3)
Headers() = Array("Item", "Configuration", "Drawing/Document Number", "Title", "ECN", "Date", "Revisions")
' Set Do loop to stop when two consecutive empty cells are reached.
For Row = 1 To LastRow 'Add a loop to go through the cells in each row?
If Range("C" & Row).Value = "" Then 'If row is empty, then go in and add headers
For i = LBound(Headers()) To UBound(Headers())
Cells(Row, 1 + i).Value = Headers(i)
Next i
Rows(Row).Font.Bold = True
'Loop here
End If
Next Row
Application.ScreenUpdating = True 'turn it back on
MsgBox ("Done!")
End Sub
Edit; Include image of output of above code.
Here's how I would do it:
Sub AddHeaders()
Dim nRow As Integer
nRow = 1
Do Until Range("C" & nRow) = "" And Range("C" & nRow + 1) = ""
If Range("C" & nRow) = "" Then
Range("A" & nRow & ":D" & nRow) = "Header"
End If
nRow = nRow + 1
Loop
End Sub
I am trying to copy rows that contain data (in cells A, B, C, D) down into the same cells (in the different rows) if the cells are blank. So basically copying the data in the above cells if the preceding cells are empty. The code I have is as follows:
Sub PadOut()
With Range("A2:D300") ' change this
On Error Resume Next
Set aRange = .SpecialCells(xlCellTypeBlanks) 'check for blank cells
On Error Goto 0
If Not aRange Is Nothing Then
aRange.FormulaR1C1 = "=R[-1]C"
.Value = .Value
End If
End With
End Sub
Currently I have it at a set range.. But how can I set so as the range can be expanded (if I didn't know the number of total rows)
Is this what you're trying to achieve? You can change the start row and column number as neccessary. The endCol variable defines the last colulmn to scan through and the endRow loop finds the last used row in the defined column range.
Sub PadOut()
Application.ScreenUpdating = False
Dim startRow As Long
startRow = 2
Dim startCol As Long
startCol = 1
Dim endCol As Long
endCol = 3
With ActiveSheet
Dim row As Long
Dim col As Long
Dim endRow As Long
Dim bottomRow As Long
bottomRow = ActiveSheet.Rows.Count
Dim colEndRow As Long
endRow = 0
For col = startCol To endCol
If (Cells(bottomRow, col).End(xlUp).row > endRow) Then
endRow = Cells(bottomRow, col).End(xlUp).row
End If
Next col
For col = startCol To endCol
For row = startRow + 1 To endRow
If .Cells(row, col).value = "" Then
.Cells(row, col).value = .Cells(row - 1, col).value
End If
Next row
Next col
End With
Application.ScreenUpdating = True
End Sub
Sub PadOut()
lastRow = ActiveSheet.UsedRange.Rows.Count
if cells(lastRow, 1) = "" and cells(lastRow, 2) = "" and cells(lastRow, 3) = "" and cells(lastRow, 4) = "" then
lastRow = WorksheetFunction.Max(cells(lastRow, 1).end(xlup).row, cells(lastRow, 2).end(xlup).row, cells(lastRow, 3).end(xlUp).row, cells(lastRow, 4).end(xlup).row)
end if
With Range("A2:D" & lastRow)
On Error Resume Next
Set aRange = .SpecialCells(xlCellTypeBlanks) 'check for blank cells
On Error Goto 0
If Not aRange Is Nothing Then
aRange.FormulaR1C1 = "=R[-1]C"
.Value = .Value
End If
End With
End Sub
You can get the total number of rows using the following:
numberRows = ActiveSheet.UsedRange.Rows.Count
Then you can set up the range accordingly.
You don't really need VBA for this task.
It can be accomplished with use of the selection page and array filling.
To do this:
Highlight your range, starting with the first row and cell that has blank data you are interested in filling.
Next, press CTRL+G, this will display the "Go To" window, press Special.... Select the "blanks" option and press OK.
This will select all BLANK cells in your range. Then, without clicking (or you will change your selection), type: = {Press UP arrow} then press CTRL + ENTER
Your Data Before // Your Data After
Below are my codes, I am trying to force the checking to start from the first cell, but it doesn't work. Can anyone advise me on that. Thanks
I am trying to do checking on the names which is on the 3rd column of Workbook A and compare it with the other column in another workbook. Upon match of the string, it will copy certain cells to the desalinated column
Sub copyandpaste()
Set From_WS = Workbooks("copy_data2").Worksheets("Data")
Set To_WS = Workbooks("Book1").Worksheets("Sheet1")
Dim v1 As String
Dim v2 As String
Dim diffRow As Long
Dim dataWs As Worksheet
Dim copyWs As Worksheet
Dim rowData As Long
Dim totRows As Long
Dim lastRow As Long
Dim result As String
Dim row_no As Integer
Dim Name As Range
Dim Namelist As Range
diffRow = 1 'compare
Set dataWs = Worksheets("Data")
Set copyWs = Worksheets("Diff")
For Each c In Worksheets("Data").Range("C2:C10")
If c.Value <> "" Then
v1 = c
End If
For Each d In Workbooks("Book1").Worksheets("Sheet1").Range("B2:B10")
If d.Value <> "" Then
v2 = d
End If
With From_WS.Cells(1, 2).CurrentRegion
Total_Rows = .Rows.Count
Total_Columns = .Columns.Count
End With
Set mycellA = From_WS.Range("C:C")
Set mycellB = To_WS.Range("B:B")
Copy = False
' With Sheets("copy_data2")
' lastRow = .Range("A" & .Rows.Count).End(xlUp).Row
'find first row
'column1 = Range("A2").End(xlToRight).Column
'For row_no = 1 To 10
'=========================================================================
Set Namelist = dataWs.Range("A1:A" & dataWs.Cells(Rows.Count, "A").End(xlUp).Row)
'Now loop through all the cells in the range
'For Each Name In Namelist.Cells
mynumber = 1
For Each Name In Namelist
'=======================================================================
If v1 = v2 Then
'select sheet
Sheets("Data").Select
'ActiveCell.Select 'select active cell
ActiveCell.Interior.ColorIndex = 36 'color the cell
'copy active cell same row
ActiveCell.Range("A1:F1").Copy
ActiveCell.Interior.ColorIndex = 50 'color the cell
'Paste file destination
Sheets("Diff").Select
Sheets("Diff").Range("A2").Select
'Paste Active
ActiveSheet.Paste
ActiveCell.Interior.ColorIndex = 37 '<< Colored Blue
'==================================================================
'select sheet
Sheets("Data").Select
'ActiveCell.Select 'select active cell
ActiveCell.Interior.ColorIndex = 36 'color cell Yellow
'result = ActiveCell.EntireRow.copy
'copy active cell same row
ActiveCell.Range("H1:J1").Copy
'Paste file destination
Sheets("Diff").Select
'Paste cell destination
Sheets("Diff").Range("G2").Select
'Paste Active
ActiveSheet.Paste
mynumber = mynumber + 1
End If
Next Name
Next d
Next c
End Sub
This is the second function, to count and go through the rows.
Sub RoundToZero1()
For Counter = 1 To 20
Set curCell = Worksheets("Data").Cells(Counter, 3)
If Abs(curCell.Value) < 0.01 Then curCell.Value = 0
Next Counter
End Sub
Update Question:
I have the code below, I need to make the column A to be incremental. Anyone have suggestion how to achieve that?
Sheets("Diff").Range("A").Select
The line Set selectedCell = selectedCell + 1 throws an error when I run it and doesn't appear to do anything in the code, if that is the case you should comment it out or delete it.
Also I think you need to change
Else
If IsEmpty(Cells(i, 1)) = True Then 'if cells in column "A" is empty then stop
to
ElseIf IsEmpty(Cells(i, 1)) = True Then 'if cells in column "A" is empty then stop
As it stands you have an extra open If statement.