Brackets prevent function from running - vba

I am having difficulty getting my function to recognise the procedure because of where the brackets are.
The following code does not work.
Function
Public Function KonKatenate(rIN As range) As String
Dim r As range
For Each r In rIN
KonKatenate = Replace(KonKatenate & r.Text, ".", "")
Next r
End Function
Procedure
Sub LoopThroughUntilBlanks()
Dim xrg As range
Cells(3, 951).Select
' Set Do loop to stop when two consecutive empty cells are reached.
Application.ScreenUpdating = False
i = 3
Do Until IsEmpty(ActiveCell) And IsEmpty(ActiveCell.Offset(0, -2).Value)
Cells(i, 951).Value = KonKatenate(range("AJE" & i & ":AJG" & i & ")"))
ActiveCell.Offset(1, 0).Select
i = i + 1
Loop
Application.ScreenUpdating = False
End Sub
When i completely remove the brackets and use for example a static number this works:
Cells(i, 951).Value = KonKatenate(range("AJE3:AJG3"))
However i need 3 to be a variable i so that the loop transcends down the row
Advice is much needed

Your KonKatenate function keeps overwriting its own result as it loops through the range. You need to keep concatenating the new new string onto the result. You didn't have a delimiter in your original but I've added an easy way to include one.
Public Function KonKatenate(rIN As range) As String
Dim r As range, d as string
d = ""
For Each r In rIN
KonKatenate = KonKatenate & d & Replace(r.Text, ".", "")
Next r
KonKatenate = mid(KonKatenate, len(d)+1)
End Function
Your LoopThroughUntilBlanks sub procedure should use the vars it declares and declare the vars it uses. A For ... Next loop may be more appropriate.
Sub LoopThroughUntilBlanks()
dim lr as long, i as long
Application.ScreenUpdating = False
with activesheet '<~~ would be better as a defined worksheet
lr = application.max(.cells(.rows.coun, "AJO").end(xlup).row, _
.cells(.rows.coun, "AJO").Offset(0, -2).end(xlup).row)
for i=3 to lr
.Cells(i, "AJO").Value = KonKatenate(.range(.cells(i, "AJE"), .cells(i, "AJG")))
next i
end with
Application.ScreenUpdating = False
End Sub

Another option, without loops
Option Explicit
Public Sub Kat_AJEtoAJG()
Dim lrO As Long, lrM As Long
With ThisWorkbook.Worksheets("Sheet3") 'or ThisWorkbook.Activesheet
lrO = .Cells(.Rows.Count, "AJO").End(xlUp).Row
lrM = .Cells(.Rows.Count, "AJM").End(xlUp).Row
With .Range(.Cells(3, "AJO"), .Cells(IIf(lrO > lrM, lrO, lrM), "AJO"))
.Formula = "=AJE3 & AJF3 & AJG3"
.Value2 = .Value2
.Replace ".", vbNullString
End With
End With
End Sub

Related

Run-time error 1004: Application-defined or object-defined error in VBA

I'm trying to convert a column of values from Decimal to Binary and for some reason I get this error. I'm new to VBA coding so i might be missing on some basic information.
The code I have:
Private Sub CommandButton1_Click()
Dim i As Integer
Dim r As Range
Dim myRange As Range: Set myRange = Range("E2:E2000") 'define your range
Dim rcopy As Range
Dim myCopyRange As Range: Set myCopyRange = Range("P2:P2000") 'range for the converted values
For i = 1 To myRange.Cells.Count
myCopyRange.Cells(i).Value = WorksheetFunction.Dec2Bin(myRange.Cells(i).Value)
Next
End Sub
My E column with the values that must be converted is set on Number format, and my P column is set right now on Text. However I tried changing the format of the columns to Number or General and I keep on getting the same error.
Thank you for the help:)
So a few things:
1). Dec2Bin can't handle numbers larger than 511 and will throw a 1004Error if you try to do so.
2). You might want to use long variable for numbers, there is no point really to use integer.
3). Another way in doing this would be like:
Private Sub CommandButton1_Click()
Dim i As Long, LR as Long
With Sheets(1)
LR = .Range("E" & .Rows.Count).End(xlUp).Row
For i = 1 To LR
If .Cells(i, 5).value < 512 then .Cells(i, 16).Value = WorksheetFunction.Dec2Bin(.Cells(i, 5).value)
Next i
End with
End Sub
EDIT
You could also opt to include a formula in your loop that will work with 32bit like so:
Private Sub CommandButton1_Click()
Dim i As Long, LR As Long
With Sheets(1)
LR = .Range("E" & .Rows.Count).End(xlUp).Row
For i = 1 To LR
.Cells(i, 16).Formula = "=DEC2BIN(E" & i & "/512^3,5) & DEC2BIN(INT(MOD(E" & i & ",512^3)/512^2),9) & DEC2BIN(INT(MOD(E" & i & ",512^2)/512),9) & DEC2BIN(MOD(E" & i & ",512),9)"
Next
End With
End Sub
EDIT2
For a dynamic sized bitnumber, you might want to use a UDF. See below:
Function DecToBin(ByVal DecimalIn As Variant, Optional NumberOfBits As Variant) As String
DecToBin = ""
DecimalIn = CDec(DecimalIn)
Do While DecimalIn <> 0
DecToBin = Trim$(Str$(DecimalIn - 2 * Int(DecimalIn / 2))) & DecToBin
DecimalIn = Int(DecimalIn / 2)
Loop
If Not IsMissing(NumberOfBits) Then
If Len(DecToBin) > NumberOfBits Then
DecToBin = "Error - Number too large for bit size"
Else
DecToBin = Right$(String$(NumberOfBits, "0") & _
DecToBin, NumberOfBits)
End If
End If
End Function
And this is how you incorporate this:
Private Sub CommandButton1_Click()
Dim i As Long, LR as Long
With Sheets(1)
LR = .Range("E" & .Rows.Count).End(xlUp).Row
For i = 1 To LR
.Cells(i, 16).Value = "'" & DecToBin(.Cells(i, 5).value)
Next i
End with
End Sub
Here is a usefull Link
You could also just call the function from your worksheet typing this formule:
=DecToBin(E1)
Hope that helps :)
Try this:
Sub test()
Dim i
For i = 2 To 2000
Cells(i, "P").Value = Application.Dec2Bin(Cells(i, "E").Value)
Next i
End Sub
Dec2Bin only accepts numbers, otherwise it throws 1004. So you should check the type of the value before passing it to Dec2Bin, like this:
If Typename(myRange.Cells(i).Value)="Double" Then ...
Typename returns Double for numbers, other values can be String, Date, Empty.

VBA Add formula to specific columns and fill down to last row

I'm in the process of trying to automate my monthly reporting and I'm finally dipping my toe into VBA (by copying a bunch of stuff I see online and trying to make it work with my project).
I currently have a macro that inserts colums in Column A,H,O etc. and now I want another macro to insert a =CONCATENATE formula into each of them and fill down to last row with data (I'll then string these two macros together).
I currently have the following
Sub FillDown()
Dim strFormulas(1 To 5) As Variant
With ThisWorkbook.Worksheets("CommentsData")
strFormulas(1) = "=CONCATENATE(B1,C1)"
strFormulas(2) = "=CONCATENATE(I1,J1)"
strFormulas(3) = "=CONCATENATE(P1,Q1)"
strFormulas(4) = "=CONCATENATE(W1,X1)"
strFormulas(5) = "=CONCATENATE(AD1,AE1)"
.Range("A1,H1,O1,V1,AC1").Formula = strFormulas
.Range("A1,H1,O1,V1,AC1").FillDown
.Range("A:AG").NumberFormat = "General"
End With
End Sub
I'm getting a Runtime 1004 "Filldown method of Range class failed error with the Range Line being highlighted. I assume there is an issue with the way I'm trying to refer to multiple columns that aren't side by side (haven't been able to find examples of this online).
Any help is appreciated.
Follow up question; Once I have this working, I'll want to do it with other worksheets within the workbook as well, but it will be different columns. Do I need to create a new module or can I just paste the code again in the same module and alter the ranges/cell references? If so, which part do I copy/paste
In this specific example you could simplify to:
Option Explicit
Public Sub FillDown1()
Dim myColumns(), lastRow As Long, i As Long
myColumns = Array("A", "H", "O", "V", "AC")
With ThisWorkbook.Worksheets("CommentsData")
lastRow = .Cells(.Rows.Count, "B").End(xlUp).row 'Change this to a column which you can use to determine how far to add formulas to
For i = LBound(myColumns) To UBound(myColumns)
.Range(.Cells(1, myColumns(i)), .Cells(lastRow, myColumns(i))).FormulaR1C1 = "=CONCATENATE(RC[1],RC[2])"
Next i
.Range("A:AG").NumberFormat = "General"
End With
End Sub
Something closer to yours, but boy is it ugly looking:
Public Sub FillDown2()
Dim myColumns(), lastRow As Long, i As Long, myFormulas(1 To 5) As Variant
myColumns = Array("A", "H", "O", "V", "AC")
myFormulas(1) = ("B,C")
myFormulas(2) = ("I,J")
myFormulas(3) = ("P,Q")
myFormulas(4) = ("W,X")
myFormulas(5) = ("AD,AE")
If UBound(myColumns) + 1 <> UBound(myFormulas) Then MsgBox "Array length for myColumns doesn't match myFormulas": Exit Sub
With ThisWorkbook.Worksheets("CommentsData")
lastRow = .Cells(.Rows.Count, "B").End(xlUp).row 'Change this to a column which you can use to determine how far to add formulas to
For i = LBound(myColumns) To UBound(myColumns)
.Cells(1, myColumns(i)).Formula = "=CONCATENATE(" & Split(myFormulas(i + 1), ",")(0) & 1 & "," & Split(myFormulas(i + 1), ",")(1) & 1 & ")"
.Range(.Cells(1, myColumns(i)), .Cells(lastRow, myColumns(i))).FillDown
Next i
.Range("A:AG").NumberFormat = "General"
End With
End Sub
You could even shift the row (1) back up into the myFormulas array
Public Sub FillDown2()
Dim myColumns(), lastRow As Long, i As Long, myFormulas(1 To 5) As Variant
myColumns = Array("A", "H", "O", "V", "AC")
myFormulas(1) = ("B1,C1") '<==========================shifted row back up into array
myFormulas(2) = ("I1,J1")
myFormulas(3) = ("P1,Q1")
myFormulas(4) = ("W1,X1")
myFormulas(5) = ("AD1,AE1")
If UBound(myColumns) + 1 <> UBound(myFormulas) Then MsgBox "Array length for myColumns doesn't match myFormulas": Exit Sub
With ThisWorkbook.Worksheets("CommentsData")
lastRow = .Cells(.Rows.Count, "B").End(xlUp).row 'Change this to a column which you can use to determine how far to add formulas to
For i = LBound(myColumns) To UBound(myColumns)
.Cells(1, myColumns(i)).Formula = "=CONCATENATE(" & Split(myFormulas(i + 1), ",")(0) & "," & Split(myFormulas(i + 1), ",")(1) & ")"
.Range(.Cells(1, myColumns(i)), .Cells(lastRow, myColumns(i))).FillDown
Next i
.Range("A:AG").NumberFormat = "General"
End With
End Sub
you could try this:
Sub FillDown()
With ThisWorkbook.Worksheets("CommentsData")
.Range("A:A,H:H,O:O,V:V,AC:AC").Offset(, 1).SpecialCells(xlCellTypeConstants).Offset(, -1).FormulaR1C1 = "=CONCATENATE(RC[1],RC[2])"
.Range("A:AG").NumberFormat = "General"
End With
End Sub
to extend it to more worksheets:
Sub FillDownMoreSheets()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets(Array("CommentsData", "CommentsData2", "CommentsData3"))
With ws
.Range("A:A,H:H,O:O,V:V,AC:AC").Offset(, 1).SpecialCells(xlCellTypeConstants).Offset(, -1).FormulaR1C1 = "=CONCATENATE(RC[1],RC[2])"
.Range("A:AG").NumberFormat = "General"
End With
Next
End Sub
You should avoid naming your Subs, Functions and variables with reserved words
FillDown will hide the built-in Range.FillDown Method
This will work on all sheets defined in the constant at the top
The list in WS_RANGES is separated by a space and contains a sub list of
SheetName-Range-ColumnOffset (CommentsData-A1:AG-7)
ColumnOffset must be 3 or greater (for the formulas)
Option Explicit
Public Sub JoinColumns()
Const WS_RANGES = "CommentsData-A1:AG-7 CommentsData2-C2:AX-3" 'WSNames-Range-Offset
Dim wsSet As Variant, ws As Worksheet, ur As Range, cls As Range, i As Variant, c As Long
wsSet = Split(WS_RANGES)
For Each ws In ThisWorkbook.Worksheets
For Each i In wsSet
i = Split(i, "-")
If ws.Name = i(0) Then
Set ur = ws.Range(i(1) & ws.Cells(ws.Rows.Count, Split(i(1),":")(1)).End(xlUp).Row)
Set cls = ur.Columns(1)
For c = i(2) + 1 To ur.Columns.Count Step i(2)
Set cls = Union(cls, ur.Columns(c))
Next
cls.Formula = "=RC[1] & RC[2]"
ur.NumberFormat = "General"
Exit For
End If
Next
Next
End Sub

A better way in VBA to remove a whole row if one cell contains one certain word?

I wrote the following code, which looks for 3 words in the column G and then in case, that one of those occurs it delete the whole row.
However, it is not so efficient(quick). I guess because of 3 If and ElseIf.
Does someone know a better way to do it?
Last = Workbooks("reportI.xlsm").Sheets("SII_I").Cells(Rows.Count, "G").End(xlUp).Row
For i = 2 To Last Step 1
If (Workbooks("reportI.xlsm").Sheets("SII_I").Cells(i, "G").Value) = "01NU SfG" Then
Workbooks("reportI.xlsm").Sheets("SII_I").Cells(i, "A").EntireRow.Delete
'
'with the word "01NU" in column G
ElseIf (Workbooks("reportI.xlsm").Sheets("SII_I").Cells(i, "G").Value) = "01NU" Then
Workbooks("reportI.xlsm").Sheets("SII_I").Cells(i, "A").EntireRow.Delete
'with the word "11G SfG" in column G
ElseIf (Workbooks("reportI.xlsm").Sheets("SII_I").Cells(i, "G").Value) = "11G SfG" Then
Cells(i, "A").EntireRow.Delete
End If
Debug.Print i
Next i
You can use just one if clause by using the OR operator.
If "A1"= "01NU OR "A1" = "SfG" OR "A1" = "11G SfG" Then
'delete row
Alternatively, you can get your macro to filter that column for the values 01NU, SfG, 11G SfG, and then delete all the filtered rows. This is definitely more faster.
Just replace range A1 by your required range.
Another solution:
Sub Demo()
Dim delItems As String
Dim rng As Range, searchRng As Range, cel As Range
Dim lastRow As Long
delItems = "01NU SfG,01NU,11G SfG" 'search items
With Workbooks("reportI.xlsm").Sheets("SII_I")
lastRow = .Cells(Rows.Count, "G").End(xlUp).Row
Set searchRng = .Range("G1:G" & lastRow)
For Each cel In searchRng
If InStr(1, delItems, cel.Value, vbTextCompare) Then
If rng Is Nothing Then
Set rng = .Rows(cel.Row)
Else
Set rng = Union(rng, .Rows(cel.Row))
End If
End If
Next cel
End With
rng.Delete
End Sub
The code would need a little alteration to fit your needs, but this answer is very robust and scalable.
For example:
Sub Sample()
Dim DeleteThese(3) As String, strg As String
Dim rng As Range
Dim Delim As String
Dim Last As Long
Dim ws As Worksheet
Set ws = Workbooks("reportI.xlsm").Sheets("SII_I")
Last = ws.Cells(Rows.Count, "G").End(xlUp).Row
Delim = "#"
DeleteThese(0) = "01NU SfG"
DeleteThese(1) = "01NU"
DeleteThese(2) = "11G SfG"
strg = Join(DeleteThese, Delim)
strg = Delim & strg
For i = 2 To Last Step 1
If InStr(1, strg, Delim & ws.Range("G" & i).Value & Delim, vbTextCompare) Then _
ws.Range("G" & i).EntireRow.Delete
Next i
End Sub

Need help trimming spaces out of column

I am trying to figure out how to loop through the first column of my worksheet and take out the spaces so I can use VLOOKUP. Not sure how to do it in VBA. Here is what I have:
I can't figure out why it does not go onto the next sheet now? I can't just cycle through all of the sheets since they are different.
Sub trima()
Dim x As Integer
Dim numrows As Long
numrows = Range("A1",Range("A1").End(xlDown)).Rows.Count
Range("A1").Select
For x = 1 To numrows
Application.WorksheetFunction.trim (ActiveCell)
ActiveCell.Offset(1, 0).Select
Next
End Sub
Here you go:
Sub TrimA()
Dim v
v = [transpose(transpose(trim(a1:index(a:a,match("",a:a,-1)))))]
[a1].Resize(UBound(v)) = v
End Sub
UPDATE
If you want to update multiple sheets, you can utilize the above like so:
Sub DoTrims()
Sheet1.Activate: TrimA
Sheet2.Activate: TrimA
'etc.
End If
The Trim function does not work like that.
Instead, try something like:
Sub trima()
Dim numrows As Long
Dim vItem as Variant
Dim i As Long
numrows = Range("A1",Range("A1").End(xlDown)).Rows.Count
Application.ScreenUpdating = False
With ActiveSheet
For i = 1 To numrows
vItem = .Range("A" & i)
If vItem <> vbNullString then .Range("A" & i) = Application.WorksheetFunction.Trim(vItem)
Next
End With
Application.ScreenUpdating = True
End Sub
The following code will loop through ALL worksheets in the Workbook and perform the same trim on values in Column A:
Sub trimA()
Dim ws As Excel.Worksheet
Dim i As Long, numrows As Long
Dim vItem As Variant
Application.ScreenUpdating = False
For Each ws In Worksheets
With ws
numrows = .Range("A1", .Range("A1").End(xlDown)).Rows.Count
For i = 1 To numrows
vItem = .Range("A" & i)
If vItem <> vbNullString Then .Range("A" & i) = Application.WorksheetFunction.Trim(vItem)
Next i
End With
Next
Application.ScreenUpdating = True
End Sub
Using the Range.TextToColumns method should quickly clear all cells containing leading/trailing spaces.
This procedure can quickly convert text-that-look-like-numbers to true numbers as well.
Dim c As Long
With Range("A1").CurrentRegion `<~~ set to the desired range of one or more columns
For c = 1 To .Columns.Count
.Columns(c).TextToColumns Destination:=.Columns(c), _
DataType:=xlFixedWidth, FieldInfo:=Array(0, 1)
Next c
End With
If the cells actually contain non-standard spacing like the non-breaking space (common on data copied from a web page) then other Range.Replace method should be added.

Efficient way to delete entire row if cell doesn't contain '#' [duplicate]

This question already has answers here:
Delete Row based on Search Key VBA
(3 answers)
Closed 8 years ago.
I'm creating a fast sub to do a validity check for emails. I want to delete entire rows of contact data that do not contain a '#' in the 'E' Column. I used the below macro, but it operates too slowly because Excel moves all the rows after deleting.
I've tried another technique like this: set rng = union(rng,c.EntireRow), and afterwards deleting the entire range, but I couldn't prevent error messages.
I've also experimented with just adding each row to a selection, and after everything was selected (as in ctrl+select), subsequently deleting it, but I could not find the appropriate syntax for that.
Any ideas?
Sub Deleteit()
Application.ScreenUpdating = False
Dim pos As Integer
Dim c As Range
For Each c In Range("E:E")
pos = InStr(c.Value, "#")
If pos = 0 Then
c.EntireRow.Delete
End If
Next
Application.ScreenUpdating = True
End Sub
You don't need a loop to do this. An autofilter is much more efficient. (similar to cursor vs. where clause in SQL)
Autofilter all rows that don't contain "#" and then delete them like this:
Sub KeepOnlyAtSymbolRows()
Dim ws As Worksheet
Dim rng As Range
Dim lastRow As Long
Set ws = ActiveWorkbook.Sheets("Sheet1")
lastRow = ws.Range("E" & ws.Rows.Count).End(xlUp).Row
Set rng = ws.Range("E1:E" & lastRow)
' filter and delete all but header row
With rng
.AutoFilter Field:=1, Criteria1:="<>*#*"
.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
End With
' turn off the filters
ws.AutoFilterMode = False
End Sub
NOTES:
.Offset(1,0) prevents us from deleting the title row
.SpecialCells(xlCellTypeVisible) specifies the rows that remain after the autofilter has been applied
.EntireRow.Delete deletes all visible rows except for the title row
Step through the code and you can see what each line does. Use F8 in the VBA Editor.
Have you tried a simple auto filter using "#" as the criteria then use
specialcells(xlcelltypevisible).entirerow.delete
note: there are asterisks before and after the # but I don't know how to stop them being parsed out!
Using an example provided by user shahkalpesh, I created the following macro successfully. I'm still curious to learn other techniques (like the one referenced by Fnostro in which you clear content, sort, and then delete). I'm new to VBA so any examples would be very helpful.
Sub Delete_It()
Dim Firstrow As Long
Dim Lastrow As Long
Dim Lrow As Long
Dim CalcMode As Long
Dim ViewMode As Long
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
With ActiveSheet
.Select
ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView
.DisplayPageBreaks = False
'Firstrow = .UsedRange.Cells(1).Row
Firstrow = 2
Lastrow = .Cells(.Rows.Count, "E").End(xlUp).Row
For Lrow = Lastrow To Firstrow Step -1
With .Cells(Lrow, "E")
If Not IsError(.Value) Then
If InStr(.Value, "#") = 0 Then .EntireRow.Delete
End If
End With
Next Lrow
End With
ActiveWindow.View = ViewMode
With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With
End Sub
When you are working with many rows and many conditions, you better off using this method of row deletion
Option Explicit
Sub DeleteEmptyRows()
Application.ScreenUpdating = False
Dim ws As Worksheet
Dim i&, lr&, rowsToDelete$, lookFor$
'*!!!* set the condition for row deletion
lookFor = "#"
Set ws = ThisWorkbook.Sheets("Sheet1")
lr = ws.Range("E" & Rows.Count).End(xlUp).Row
ReDim arr(0)
For i = 1 To lr
If StrComp(CStr(ws.Range("E" & i).Text), lookFor, vbTextCompare) = 0 then
' nothing
Else
ReDim Preserve arr(UBound(arr) + 1)
arr(UBound(arr) - 1) = i
End If
Next i
If UBound(arr) > 0 Then
ReDim Preserve arr(UBound(arr) - 1)
For i = LBound(arr) To UBound(arr)
rowsToDelete = rowsToDelete & arr(i) & ":" & arr(i) & ","
Next i
ws.Range(Left(rowsToDelete, Len(rowsToDelete) - 1)).Delete Shift:=xlUp
Else
Application.ScreenUpdating = True
MsgBox "No more rows contain: " & lookFor & "or" & lookFor2 & ", therefore exiting"
Exit Sub
End If
If Not Application.ScreenUpdating Then Application.ScreenUpdating = True
Set ws = Nothing
End Sub
Instead of looping and referencing each cell 1 by 1, grab everything and put it into a variant array; Then loop the variant array.
Starter:
Sub Sample()
' Look in Column D, starting at row 2
DeleteRowsWithValue "#", 4, 2
End Sub
The Real worker:
Sub DeleteRowsWithValue(Value As String, Column As Long, StartingRow As Long, Optional Sheet)
Dim i As Long, LastRow As Long
Dim vData() As Variant
Dim DeleteAddress As String
' Sheet is a Variant, so we test if it was passed or not.
If IsMissing(Sheet) Then Set Sheet = ActiveSheet
' Get the last row
LastRow = Sheet.Cells(Sheet.Rows.Count, Column).End(xlUp).Row
' Make sure that there is work to be done
If LastRow < StartingRow Then Exit Sub
' The Key to speeding up the function is only reading the cells once
' and dumping the values to a variant array, vData
vData = Sheet.Cells(StartingRow, Column) _
.Resize(LastRow - StartingRow + 1, 1).Value
' vData will look like vData(1 to nRows, 1 to 1)
For i = LBound(vData) To UBound(vData)
' Find the value inside of the cell
If InStr(vData(i, 1), Value) > 0 Then
' Adding the StartingRow so that everything lines up properly
DeleteAddress = DeleteAddress & ",A" & (StartingRow + i - 1)
End If
Next
If DeleteAddress <> vbNullString Then
' remove the first ","
DeleteAddress = Mid(DeleteAddress, 2)
' Delete all the Rows
Sheet.Range(DeleteAddress).EntireRow.Delete
End If
End Sub