How to Exclude a Specific Row from a Find Last Column Function - vba

I've created a spreadsheet that creates an inventory list. The Macro i'm writing opens my intranets search page, enters the catalog number in row a (not shown in image). and returns information to the excel sheet. As it enters locations (RIG), It creates a header in row 2. I created a second macro that removes inactive locations. After this filter, I'm left with a cleaner list, but I want to remove the header in row 2 that no longer has information below it (i.e. columns AH, AI, AJ and so on). I know I can find the last used column of the worksheet, but what i want to do is clear formatting , border and contents in row2 whenever row3 to lastrow is empty.
Is there a way to adjust this to exclude the row2 from the search?
Dim LastColumn As Integer
Set LastColumn = Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
Cells(2,LastColumn).Select
ActiveCell.Offset(0,1)
Do
If not ActiveCell = "" Then
ActiveCell.EntireColumn.Delete(xlToLeft)
DoEvents
Else
Exit Do
End If
Loop
Final Code after incorporating Gary's Students Response. Thank you!!
'Find last used column below header row
Dim wf As WorksheetFunction
Dim N As Long
Dim rCol As Range
Set wf = Application.WorksheetFunction
Cells(1, 1).EntireRow.Hidden = True
Cells(2, 1).EntireRow.Hidden = True
Do
For N = Columns.Count To 1 Step -1
Set rCol = Cells(1, N).EntireColumn
If wf.Subtotal(103, rCol) > 0 Then
Exit Do
End If
Next
Loop
Cells(1, 1).EntireRow.Hidden = False
Cells(2, 1).EntireRow.Hidden = False
'Trim header row to used columns only
Cells(2, N).Select
ActiveCell.Offset(0, 1).Select
Do
If Not ActiveCell = "" Then
ActiveCell.EntireColumn.Delete (xlToLeft)
DoEvents
Else
Exit Do
End If
Loop

Just exclude the row from the examination:
Sub FindLastColumn()
Dim BadRow As Long, wf As WorksheetFunction
Dim N As Long, rCol As Range, i As Long
BadRow = 7
i = 103
Set wf = Application.WorksheetFunction
Cells(BadRow, 1).EntireRow.Hidden = True
For N = Columns.Count To 1 Step -1
Set rCol = Cells(1, N).EntireColumn
If wf.Subtotal(i, rCol) > 0 Then
MsgBox "The last used column is: " & N
Cells(BadRow, 1).EntireRow.Hidden = False
Exit Sub
End If
Next N
Cells(BadRow, 1).EntireRow.Hidden = False
End Sub

So basically from what I can understand you are trying to do a search and exclude some rows from the search? Why not use a double loop?
for i 1 to columns you want
for j = 1 to rows you want
if j <> row you don't want
'add code here
end if
nextj
next i

Related

VBA Nested Do While Loop vs. Nested Do While If Loop

I'm not sure where I'm going wrong. I'm trying to compare values within a column ("B") to a cell referenced to ("A1"). If the values in Column "B" equal "A1" I want it to count up. When it gets to the end of Column "B" I'm trying to get it to loop back and compare values in column "B" with "A2", etc. For example:
So Far I've written two different codes one with a nested do while loop and a nested do while if loop but i cant get them to loop through the whole column
Sub CountDb()
Dim i As Long
Dim iRow As Long
Dim initial As Long
i = 1
iRow = 1
initial = 1
Do While Cells(iRow, "A").Value <> "" 'initial loop, whilst there are values in cell "A" continue the loop
Do While Cells(i, "B").Value = Cells(iRow, "A").Value 'nested while loop, comparing the first B1 and cell A1.
If True Then Cells(i, "C") = initial 'if they A1 and B1 are equal, print 1 in column C
initial = initial + 1 'and move on comparing A1 with B2
If False Then
i = i + 1 'if not satisfied, move on to cell B2 etc.
Loop
iRow = iRow + 1 'when you get to the end of column B, start again and compare values with A2 and B
Loop
End Sub
Sub CountDb()
Dim i As Long
Dim iRow As Long
Dim initial As Long
'same comments as above, just different methodology
i = 1
iRow = 1
initial = 1
Do While Cells(iRow, "A").Value <> ""
If Cells(i, "B").Value = Cells(iRow, "A").Value Then
Cells(i, "C") = initial
Else
initial = initial + 1
i = i + 1
End If
iRow = iRow + 1
Loop
End Sub
Any help would be appreciated. Thanks!
*EDIT - fixed up column references
**EDIT - applied comments to code
Try this instead:
Option Explicit
Sub test()
Dim sht As Worksheet
Dim lastrow As Long, i as integer, j as integer, initial as integer
Set sht = Workbooks("Book1").Worksheets("Sheet1") 'Don't forget to change this
lastrow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
For i = 1 To lastrow
initial = 1
lastrow = sht.Cells(sht.Rows.Count, "B").End(xlUp).Row
For j = 1 To lastrow
If Workbooks("Book1").Worksheets("Sheet1").Range("A" & i).Value = Workbooks("Book1").Worksheets("Sheet1").Range("B" & j).Value Then
Workbooks("Book1").Worksheets("Sheet1").Range("C" & j).Value = initial
initial = initial + 1
End If
Next j
Next i
End Sub
I prefer using For loops as opposed to Whiles, just because I can see the ranges being looped through more easily. Here we use nested For loops, the first to loop through column A, the second to loop through column B. If our value in column A equals our value in column B, we place the initial number in column C using our variable from the nested loop.
Notice how to make this work, we re-initialize our lastrow variable to make the ranges for our loops.
It is useful to use countif.
Sub test()
Dim rngOrg As Range, rngDB As Range
Dim Wf As WorksheetFunction
Dim vR() As Variant
Dim i As Long, n As Long
Set Wf = WorksheetFunction
Set rngOrg = Range("a1", Range("a" & Rows.Count).End(xlUp))
Set rngDB = Range("b1", Range("b" & Rows.Count).End(xlUp))
n = rngDB.Rows.Count
ReDim vR(1 To n, 1 To 1)
For Each Rng In rngDB
i = i + 1
If Wf.CountIf(rngOrg, Rng) Then
vR(i, 1) = Wf.CountIf(Range("b1", Rng), Rng)
End If
Next Rng
Range("c1").Resize(n) = vR
End Sub
Here is another method, this time using Find. This is probably quicker than the looping method since it leverages the in-built find function to skip to the next match.
I've commented the code below for clarity, but basically we loop through values in column A (using a For loop because they're less prone to disguised infinite looping than While) and look for them in column B.
Note: This looks a bit longer, but that's mainly because (a) I've added lots of comments and (b) I've used a With statement to ensure the ranges are fully qualified.
Sub countdb()
Dim c As Range, fnd As Range, listrng As Range, cnt As Long, addr As String
' Use with so that our ranges are fully qualified
With ThisWorkbook.Sheets("Sheet1")
' Define the range to look up in (column B in this case)
Set listrng = .Range("B1", .Range("B1").End(xlDown))
' Loop over values in the index range (column
For Each c In .Range("A1", .Range("A1").End(xlDown))
cnt = 0
' Try and find the c value
Set fnd = listrng.Find(what:=c.Value, lookat:=xlWhole, LookIn:=xlValues, after:=listrng.Cells(listrng.Cells.Count))
If Not fnd Is Nothing Then
' Store the address of the first find so we can stop when we find it again!
addr = fnd.Address
' Loop over all other matches in the range. By using a "Do ... Loop While"
' style loop, we ensure that the loop is run at least once!
Do
' Increase count and assign value to next column
cnt = cnt + 1
fnd.Offset(0, 1).Value = cnt
' Find next match after current
Set fnd = listrng.Find(what:=c.Value, lookat:=xlWhole, LookIn:=xlValues, after:=fnd)
Loop While fnd.Address <> addr
End If
Next c
End With
End Sub
The trick is in making the declarations transparent. After that the programming is very easy.
Sub CountMatches()
Dim Rng As Range ' "count" range (= column "B")
Dim Itm As String ' item from the "items' column (= "A")
Dim Rla As Long, Rlb As Long ' last row in columns A and B
Dim Ra As Long, Rb As Long ' row counters
Dim Counter As Long ' count matches
With ActiveSheet
' look for the last used rows
Rla = .Cells(.Rows.Count, "A").End(xlUp).Row
Rlb = .Cells(.Rows.Count, "B").End(xlUp).Row
' start looking for matches from row 2
Set Rng = .Range(.Cells(2, "B"), .Cells(Rlb, "B"))
' start looping in row 2
For Ra = 2 To Rla
Itm = .Cells(Ra, "A").Value
If Len(Trim(Itm)) Then ' skip if blank
' start comparing from row 2
For Rb = 2 To Rlb
' compare not case sensitive
If StrComp(.Cells(Rb, "B").Value, Itm, vbTextCompare) = 0 Then
Counter = Counter + 1
End If
Next Rb
.Cells(Ra, "C").Value = Counter
Counter = 0
End If
Next Ra
End With
End Sub
Now the question is whether the transparency that workred for me appears transparent to you. I hope it does. :-)
This should be significantly faster.
Sub CountMatches_2()
Dim Rng As Range ' "count" range (= column "B")
Dim Itm As String ' item from the "items' column (= "A")
Dim Rla As Long, Rlb As Long ' last row in columns A and B
Dim Ra As Long, Rb As Long ' row counters
With ActiveSheet
' look for the last used rows
Rla = .Cells(.Rows.Count, "A").End(xlUp).Row
Rlb = .Cells(.Rows.Count, "B").End(xlUp).Row
' start looking for matches from row 2
Set Rng = .Range(.Cells(2, "B"), .Cells(Rlb, "B"))
' start looping in row 2
For Ra = 2 To Rla
Itm = .Cells(Ra, "A").Value
If Len(Trim(Itm)) Then ' skip if blank
.Cells(Ra, "C").Value = Application.CountIf(Rng, Itm)
End If
Next Ra
End With
End Sub
This code presumes that each item in column A is unique. If it is not duplicates will be created which, however, it would be easy to eliminate either before or after they are created.

How to create a multiple criteria advance filter in VBA?

I'm trying to create an advanced filter for the below table but the code below is just hiding the cells. It's working but my problem with it is if i filter something and then I drag to fill status or any other cells it will override the cells in between for example in filter mode I have 2 rows one is 1st row and the other one is at row 20 if I drag to fill status it will replace the status of all cells in between 1 and 20 and don't know how to work it out, i know this happens because I'm hiding the cells and not actually filtering them.
Any help will be much appreciated.
[Data Table][1]
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Application.EnableEvents = False
r1 = Target.Row
c1 = Target.Column
If r1 <> 3 Then GoTo ending:
If ActiveSheet.Cells(1, c1) = "" Then GoTo ending:
Dim LC As Long
With ActiveSheet
LC = .Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
End With
ActiveSheet.Range("4:10000").Select
Selection.EntireRow.Hidden = False
LR = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
For r = 5 To LR
For c = 1 To LC
If ActiveSheet.Cells(2, c) = "" Or ActiveSheet.Cells(3, c) = "" Then GoTo nextc:
If ActiveSheet.Cells(2, c) = "exact" And UCase(ActiveSheet.Cells(r, c)) <> UCase(ActiveSheet.Cells(3, c)) Then ActiveSheet.Rows(r).EntireRow.Hidden = True: GoTo nextr:
If Cells(2, c) = "exact" Then GoTo nextc:
j = InStr(1, UCase(ActiveSheet.Cells(r, c)), UCase(ActiveSheet.Cells(3, c)))
If ActiveSheet.Cells(2, c) = "partial" And j = 0 Then ActiveSheet.Rows(r).EntireRow.Hidden = True: GoTo nextr:
nextc:
Next c
nextr:
Next r
ending:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
The below code will be the answer to the question on how to create an advanced search based on multiple criteria on what the user selects in the table.
I will need a little bit of help with how to check if the user selected by mistake an empty cell I will need to make excel ignore filtering the blank cell. Also, I will need to make excel first to check if the yellow cells A3 to T3 has data in and if it has and i press the filter button will filter by the range A3:T3 and ignore the current user selection if there is no data in range A3:T3 will filter by the user selection and in the range A3:T3, if it has data will only filter by data cell that has data in them and ignore empty ones.
Sub advancedMultipleCriteriaFilter()
Dim cellRng As Range, tableObject As Range, subSelection As Range
Dim filterCriteria() As String, filterFields() As Integer
Dim i As Integer
If Selection.Rows.Count > 1 Then
MsgBox "Cannot apply filters to multiple rows within the same column. Please make another selection and try again.", vbInformation, "Selection Error!"
Exit Sub
End If
Application.ScreenUpdating = False
i = 1
ReDim filterCriteria(1 To Selection.Cells.Count) As String
ReDim filterFields(1 To Selection.Cells.Count) As Integer
Set tableObject = Selection.CurrentRegion
For Each subSelection In Selection.Areas
For Each cellRng In subSelection
filterCriteria(i) = cellRng.Text
filterFields(i) = cellRng.Column - tableObject.Cells(1, 1).Column + 1
i = i + 1
Next cellRng
Next subSelection
With tableObject
For i = 1 To UBound(filterCriteria)
.AutoFilter field:=filterFields(i), Criteria1:=filterCriteria(i)
Next i
End With
Set tableObject = Nothing
Application.ScreenUpdating = True
End Sub
Sub resetFilters()
Dim sht As Worksheet
Dim LastRow As Range
Application.ScreenUpdating = False
On Error Resume Next
If ActiveSheet.FilterMode Then
ActiveSheet.ShowAllData
End If
Range("A3:T3").ClearContents
Application.ScreenUpdating = True
Call GetLastRow
End Sub
Private Sub GetLastRow()
'Step 1: Declare Your Variables.
Dim LastRow As Long
'Step 2: Capture the last used row number.
LastRow = Cells(Rows.Count, 8).End(xlUp).Row
'Step 3: Select the next row down
Cells(LastRow, 8).Offset(1, 0).Select
End Sub

Troubleshooting Excel VBA Code

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

Excel copy rows down to blank cells

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

Finding the LastRow in multiple column ranges?

I'm trying to find the LastRow in multiple column ranges ignoring certain columns... I have two attempts but can't get either working correctly:
BOTH Examples are ignoring columns N and O
My first attempt is the following, however it doesn't get the correct last range, if I have something in A15 for example and T10, it thinks the last row is 10 when it should be 15.
Sub LastRowMacro()
LastRowString = "A1:M" & Rows.Count & ", P1:Z" & Rows.Count
LastRowTest = Range(LastRowString).Find(What:="*", After:=[A1], SearchOrder:=xlByRows, searchDirection:=xlPrevious).Row
End Sub
My second attempt is as follows, but it seems rather long winded.
Sub LastRowMacro()
Dim i As Long
LastRow = 1
IgnoreColumnList = "N;O"
For i = 1 To Cells(1, Columns.Count).End(xlToLeft).Column
ColumnLetter = Split(Cells(1, i).Address(True, False), "$")(0)
For Each varFind In Split(IgnoreColumnList, ";")
If varFind = ColumnLetter Then
varNotFound = False
Exit For
End If
varNotFound = True
Next
If varNotFound Then
CurrentLastRow = Cells(Rows.Count, i).End(xlUp).Row
If CurrentLastRow >= LastRow Then
LastRow = CurrentLastRow
End If
varNotFound = False
End If
Next
End Sub
Ideally I'd like my first attempt to work however if it just doesn't work then someone surely can improve my second version...
Try this
*There is an ignoreList variable with all the columns that you want to ignore. Make sure you populate this correctly - currently ignoring N, O, P
*You may need to set the sh variable to the correct sheet - currently it's Sheet1
*btw. this snippet will always find the last last row on the spreadsheet. you can add another elseif to check whether there are 2 columns with the same high last row in case there was 2 columns with the highest lastRows.
Sub FindingLastRow() ' ignoring some columns
Dim ignoreList
ignoreList = Array("N", "O", "P") ' MODIFY IGNORE LIST
Dim sh As Worksheet
Set sh = Sheet1 ' SET CORRECT SHEET
Dim currentlast As Range
Set currentlast = sh.Cells(1, 1)
Dim iteratingCell As Range
With sh
For j = 1 To .UsedRange.Columns.Count
Set iteratingCell = .Cells(1, j)
If Not isIgnored(iteratingCell, ignoreList) Then
If iteratingCell.Cells(Rows.Count).End(xlUp).Row >= currentlast.Cells(Rows.Count).End(xlUp).Row Then
Set currentlast = iteratingCell
End If
End If
Next
Set currentlast = .Range("$" & Split(currentlast.Address, "$")(1) & "$" & currentlast.Cells(Rows.Count).End(xlUp).Row)
End With
MsgBox currentlast.Address
End Sub
Function isIgnored(currentlast As Range, ignoreList As Variant) As Boolean
Dim ignore As Boolean
Dim letter As Variant
For Each letter In ignoreList
If StrComp(Split(currentlast.Address, "$")(1), letter, vbTextCompare) = 0 Then
ignore = True
Exit For
End If
Next
isIgnored = ignore
End Function