putting a snippet of code from one to another somehow

P

Patriot2879

Well-known Member
Joined
Feb 1, 2018
Messages
1,259
Office Version
  1. 2010
Platform
  1. Windows
Hiya good morning, i have 2 codes below that do the same sort of thing, where one adds a message if a 'name cant be found' and asks if i want to continue or not, and the other code adds a border when an email is sent. I would like the 'name cant be found bit added to the other code where the border is implemented. Hope you can help with my query please see the 2 codes below.

Below is code with name cannot be found msg box -
VBA Code: 
Private Sub CommandButton1_Click()
    Application.ScreenUpdating = False
    Dim OutApp As Object, OutMail As Object, rng As Range, v As Variant, i As Long, lRow As Long, rName As Range
    lRow = Cells(Rows.Count, "A").End(xlUp).Row
    With Sheets("Sheet1").Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("A2:A" & lRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add Key:=Range("E2:E" & lRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add Key:=Range("F2:F" & lRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange Range("A1:J" & lRow)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    v = Range("A2:A" & lRow).Resize(, 11).Value
    Set OutApp = CreateObject("Outlook.Application")
    With CreateObject("scripting.dictionary")
        For i = LBound(v) To UBound(v)
            If v(i, 11) <> "yes" Then
                Set rName = Sheets("Email Links").Range("A:A").Find(v(i, 1), LookIn:=xlValues, lookat:=xlWhole)
                If Not rName Is Nothing Then
                    If Not .exists(v(i, 1)) Then
                        .Add v(i, 1), Nothing
                        Range("A1").CurrentRegion.AutoFilter 1, v(i, 1)
                        Set rng = Range("A1:G" & lRow).SpecialCells(xlCellTypeVisible)
                        Set OutMail = OutApp.CreateItem(0)
                        With OutMail
                            .To = rName.Offset(, 21)
                            .cc = rName.Offset(, 22)
                            .Subject = "Weekly Work Issue" & "-" & v(i, 5) & "-" & v(i, 1)
                                .HTMLBody = "<p>Hi " & v(i, 1) & "," & "<br><br>" & "Please see below an overview of your work Tuesday to Friday.  Your final schedule will be emailed to you the day before the appointments are due to take place." & "<br><br>" & v(i, 10) & "<br>" & RangetoHTML(rng)
                                .Display
                        End With
                    End If
                Else
                    If MsgBox(v(i, 1) & " was not found. Do you wish to continue?", vbYesNo) = vbNo Then
                        Range("A1").AutoFilter
                        Exit Sub
                    End If
                End If
            End If
        Next i
    End With
    Range("A1").AutoFilter
    Application.ScreenUpdating = True
End Sub

Below is the code with the border and where i want the coding for 'name cannot be found' added to with msg box.

Code: 
Private Sub CommandButton1_Click()

    ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add2 Key:= _
        Range("A2", Range("A" & Rows.Count).End(xlUp)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
    ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add2 Key:= _
        Range("E2", Range("E" & Rows.Count).End(xlUp)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
    ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add2 Key:= _
        Range("F2", Range("F" & Rows.Count).End(xlUp)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Columns("A:G").Select
    With Selection
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ReadingOrder = xlContext
        .MergeCells = False
    End With

Dim answer As Integer
  answer = MsgBox("Do you want to continue?", vbQuestion + vbYesNo)

  If answer = vbNo Then Exit Sub
 
  'Some Code
 

   Dim Cl As Range
   For Each Cl In Range("A2", Range("A" & Rows.Count).End(xlUp))
      Cl.Value = Trim(Cl.Value)
   Next Cl
  
Dim lr As Long
lr = Cells(Rows.Count, "A").End(xlUp).Row
With Range("I2:I" & lr)
    .Formula = "=XLOOKUP(A2,'Email Links'!A:A,'Email Links'!V:V)"
    .Value = .Value
End With
lr = Cells(Rows.Count, "A").End(xlUp).Row
With Range("H2:H" & lr)
    .Formula = "=XLOOKUP(A2,'Email Links'!A:A,'Email Links'!W:W)"
    .Value = .Value
End With
lr = Cells(Rows.Count, "A").End(xlUp).Row
With Range("J2:J" & lr)
    .Formula = "=XLOOKUP(A2,'Email Links'!A:A,'Email Links'!Y:Y)"
    .Value = .Value
End With

'Set email address as range for first loop to run down
Set Rng = Range(Range("I2"), Range("I" & Rows.Count).End(xlUp))

'Get a row count to clear column H at the end
x = Rng.Rows.Count

PgStart = "<html><body>"

'Create the html table and header from the first row
tableHdr = "<table border=1><tr><th>" & Range("A1").Value & "</th>" _
& "<th>" & Range("B1").Value & "</th>" _
& "<th>" & Range("C1").Value & "</th>" _
& "<th>" & Range("D1").Value & "</th>" _
& "<th>" & Range("E1").Value & "</th>" _
& "<th>" & Range("F1").Value & "</th>" _
& "<th>" & Range("G1").Value & "</th>" _
'& "<th>" & Range("H1").Value & "</th>" _
'& "<th>" & Range("I1").Value & "</th>" _

'Check to see if column G = 'yes' and skip mail if it does
For Each cell In Rng
If cell.Value <> "" Then
    If Not cell.Offset(0, 2).Value = "yes" Then

      
    NmeRow = cell.Row

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.createitem(0)

    MailTo = cell.Value 'column E
mailcc = cell.Offset(0, -1).Value
MailSubject = "Weekly Work Issue" & "-" & cell.Offset(0, -4).Value & "-" & cell.Offset(0, -8).Value


'Create MailBody table row for first row
MailBody = "<tr>" _
& "<td>" & cell.Offset(0, -8).Value & "</td>" _
& "<td>" & cell.Offset(0, -7).Value & "</td>" _
& "<td>" & cell.Offset(0, -6).Value & "</td>" _
& "<td>" & cell.Offset(0, -5).Value & "</td>" _
& "<td>" & cell.Offset(0, -4).Value & "</td>" _
& "<td>" & cell.Offset(0, -3).Value & "</td>" _
& "<td>" & cell.Offset(0, -2).Value & "</td>" _
            & "</tr>"

'Second loop checks the email addresses of all cells following the current cell in the first loop.
'Yes will be appended on any duplicate finds and another row added to the mailbody table
    For Each dwn In Rng.Offset(NmeRow - 1, 0)



    If dwn.Value = cell.Value Then

'Create additional table row for each extra row found
AddRow = "<tr>" _
& "<td>" & dwn.Offset(0, -8).Value & "</td>" _
& "<td>" & dwn.Offset(0, -7).Value & "</td>" _
& "<td>" & dwn.Offset(0, -6).Value & "</td>" _
& "<td>" & dwn.Offset(0, -5).Value & "</td>" _
& "<td>" & dwn.Offset(0, -4).Value & "</td>" _
& "<td>" & dwn.Offset(0, -3).Value & "</td>" _
& "<td>" & dwn.Offset(0, -2).Value & "</td>" _
            & "</tr>"

    dwn.Offset(0, 2).Value = "yes"
    MailBody = MailBody & AddRow  'column A

    End If
' Clear additional table row variable ready for next
AddRow = ""
Next

MsgStr = "<p>Hi " & cell.Offset(0, -8).Value & "," & vbNewLine & "please see below an overview of your work Tuesday to Friday.  Your final schedule will be emailed to you the day before the appointments are due to take place." & "<br><br>" & vbNewLine & cell.Offset(0, 1).Value & "<br><br>" _



With OutMail

.To = MailTo
.CC = mailcc
.Subject = MailSubject
.HTMLBody = PgStart & MsgStr & tableHdr & MailBody & "</table></body></html>" & "<br><br>" & vbNewLine & "Any issues, please contact your FTL." & "<br><br>" & vbNewLine & "Many Thanks" & "<br><br>" & vbNewLine & "Complex Team"
.Send
'send
End With

cell.Offset(0, 2).Value = "yes"

End If
End If


MailTo = ""
MailSubject = ""
MailBody = ""
Next

'Clear 'yes' from all appended cells in column H
Range("K2:K" & x + 1).ClearContents
End Sub
 

Excel Facts

Get help while writing formula
Click the italics "fx" icon to the left of the formula bar to open the Functions Arguments dialog. Help is displayed for each argument.
Sort by date Sort by votes
I'm not 100% sure - these two sets of code are very different, but you could try modifying this bit and see if it works for you:

VBA Code: 
   Dim Cl As Range
   For Each Cl In Range("A2", Range("A" & Rows.Count).End(xlUp))
        Cl.Value = Trim(Cl.Value)
        If Len(Cl.Value) = 0 Then
            MsgBox "Name not found"
            Exit Sub
        End If
    Next Cl
 
Upvote 0
myall_blues said:
I'm not 100% sure - these two sets of code are very different, but you could try modifying this bit and see if it works for you:

VBA Code: 
   Dim Cl As Range
   For Each Cl In Range("A2", Range("A" & Rows.Count).End(xlUp))
        Cl.Value = Trim(Cl.Value)
        If Len(Cl.Value) = 0 Then
            MsgBox "Name not found"
            Exit Sub
        End If
    Next Cl
Click to expand...
This is great thanks does the job great thank you, the only thing i find is that if i have a name for example 'John Smith' on five rows it mentions the name 5 singular times in a msg box, is there any way for the msg box to op up once and say John Smith x5 not found? thnak you for your helop.
 
Upvote 0
HI i have tried updating like the following but getting a few errors -
VBA Code: 
Private Sub CommandButton1_Click()

ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add2 Key:= _
Range("A2", Range("A" & Rows.Count).End(xlUp)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add2 Key:= _
Range("E2", Range("E" & Rows.Count).End(xlUp)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add2 Key:= _
Range("F2", Range("F" & Rows.Count).End(xlUp)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Columns("A:G").Select
With Selection
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ReadingOrder = xlContext
.MergeCells = False
End With

Dim answer As Integer
answer = MsgBox("Do you want to continue?", vbQuestion + vbYesNo)

If answer = vbNo Then Exit Sub

'Some Code


Dim Cl As Range
For Each Cl In Range("A2", Range("A" & Rows.Count).End(xlUp))
Cl.Value = Trim(Cl.Value)
If Len(Cl.Value) = 0 Then
MsgBox "Name not found"
Exit Sub
End If
Next Cl

Dim lr As Long
lr = Cells(Rows.Count, "A").End(xlUp).Row
With Range("I2:I" & lr)
.Formula = "=XLOOKUP(A2,'Email Links'!A:A,'Email Links'!V:V)"
.Value = .Value
End With
lr = Cells(Rows.Count, "A").End(xlUp).Row
With Range("H2:H" & lr)
.Formula = "=XLOOKUP(A2,'Email Links'!A:A,'Email Links'!W:W)"
.Value = .Value
End With
lr = Cells(Rows.Count, "A").End(xlUp).Row
With Range("J2:J" & lr)
.Formula = "=XLOOKUP(A2,'Email Links'!A:A,'Email Links'!Y:Y)"
.Value = .Value
End With

'Set email address as range for first loop to run down
Set Rng = Range(Range("I2"), Range("I" & Rows.Count).End(xlUp))

'Get a row count to clear column H at the end
x = Rng.Rows.Count

PgStart = "<html><body>"

'Create the html table and header from the first row
tableHdr = "<table border=1><tr><th>" & Range("A1").Value & "</th>" _
& "<th>" & Range("B1").Value & "</th>" _
& "<th>" & Range("C1").Value & "</th>" _
& "<th>" & Range("D1").Value & "</th>" _
& "<th>" & Range("E1").Value & "</th>" _
& "<th>" & Range("F1").Value & "</th>" _
& "<th>" & Range("G1").Value & "</th>" _
'& "<th>" & Range("H1").Value & "</th>" _
'& "<th>" & Range("I1").Value & "</th>" _

'Check to see if column G = 'yes' and skip mail if it does
For Each cell In Rng
If cell.Value <> "" Then
If Not cell.Offset(0, 2).Value = "yes" Then


NmeRow = cell.Row

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.createitem(0)

MailTo = cell.Value 'column E
mailcc = cell.Offset(0, -1).Value
MailSubject = "Weekly Work Issue" & "-" & cell.Offset(0, -4).Value & "-" & cell.Offset(0, -8).Value


'Create MailBody table row for first row
MailBody = "<tr>" _
& "<td>" & cell.Offset(0, -8).Value & "</td>" _
& "<td>" & cell.Offset(0, -7).Value & "</td>" _
& "<td>" & cell.Offset(0, -6).Value & "</td>" _
& "<td>" & cell.Offset(0, -5).Value & "</td>" _
& "<td>" & cell.Offset(0, -4).Value & "</td>" _
& "<td>" & cell.Offset(0, -3).Value & "</td>" _
& "<td>" & cell.Offset(0, -2).Value & "</td>" _
& "</tr>"

'Second loop checks the email addresses of all cells following the current cell in the first loop.
'Yes will be appended on any duplicate finds and another row added to the mailbody table
For Each dwn In Rng.Offset(NmeRow - 1, 0)



If dwn.Value = cell.Value Then

'Create additional table row for each extra row found
AddRow = "<tr>" _
& "<td>" & dwn.Offset(0, -8).Value & "</td>" _
& "<td>" & dwn.Offset(0, -7).Value & "</td>" _
& "<td>" & dwn.Offset(0, -6).Value & "</td>" _
& "<td>" & dwn.Offset(0, -5).Value & "</td>" _
& "<td>" & dwn.Offset(0, -4).Value & "</td>" _
& "<td>" & dwn.Offset(0, -3).Value & "</td>" _
& "<td>" & dwn.Offset(0, -2).Value & "</td>" _
& "</tr>"

dwn.Offset(0, 2).Value = "yes"
MailBody = MailBody & AddRow 'column A

End If
' Clear additional table row variable ready for next
AddRow = ""
Next

MsgStr = "<p>Hi " & cell.Offset(0, -8).Value & "," & vbNewLine & "please see below an overview of your work Tuesday to Friday. Your final schedule will be emailed to you the day before the appointments are due to take place." & "<br><br>" & vbNewLine & cell.Offset(0, 1).Value & "<br><br>" _



With OutMail

.To = MailTo
.CC = mailcc
.Subject = MailSubject
.HTMLBody = PgStart & MsgStr & tableHdr & MailBody & "</table></body></html>" & "<br><br>" & vbNewLine & "Any issues, please contact your FTL." & "<br><br>" & vbNewLine & "Many Thanks" & "<br><br>" & vbNewLine & "Complex Team"
.Send
'send
End With

cell.Offset(0, 2).Value = "yes"

End If
End If


MailTo = ""
MailSubject = ""
MailBody = ""
Next

'Clear 'yes' from all appended cells in column H
Range("K2:K" & x + 1).ClearContents
End Sub
 
Upvote 0
Patriot2879 said:
HI i have tried updating like the following but getting a few errors -
VBA Code: 
Private Sub CommandButton1_Click()

ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add2 Key:= _
Range("A2", Range("A" & Rows.Count).End(xlUp)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add2 Key:= _
Range("E2", Range("E" & Rows.Count).End(xlUp)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add2 Key:= _
Range("F2", Range("F" & Rows.Count).End(xlUp)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Columns("A:G").Select
With Selection
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ReadingOrder = xlContext
.MergeCells = False
End With

Dim answer As Integer
answer = MsgBox("Do you want to continue?", vbQuestion + vbYesNo)

If answer = vbNo Then Exit Sub

'Some Code


Dim Cl As Range
For Each Cl In Range("A2", Range("A" & Rows.Count).End(xlUp))
Cl.Value = Trim(Cl.Value)
If Len(Cl.Value) = 0 Then
MsgBox "Name not found"
Exit Sub
End If
Next Cl

Dim lr As Long
lr = Cells(Rows.Count, "A").End(xlUp).Row
With Range("I2:I" & lr)
.Formula = "=XLOOKUP(A2,'Email Links'!A:A,'Email Links'!V:V)"
.Value = .Value
End With
lr = Cells(Rows.Count, "A").End(xlUp).Row
With Range("H2:H" & lr)
.Formula = "=XLOOKUP(A2,'Email Links'!A:A,'Email Links'!W:W)"
.Value = .Value
End With
lr = Cells(Rows.Count, "A").End(xlUp).Row
With Range("J2:J" & lr)
.Formula = "=XLOOKUP(A2,'Email Links'!A:A,'Email Links'!Y:Y)"
.Value = .Value
End With

'Set email address as range for first loop to run down
Set Rng = Range(Range("I2"), Range("I" & Rows.Count).End(xlUp))

'Get a row count to clear column H at the end
x = Rng.Rows.Count

PgStart = "<html><body>"

'Create the html table and header from the first row
tableHdr = "<table border=1><tr><th>" & Range("A1").Value & "</th>" _
& "<th>" & Range("B1").Value & "</th>" _
& "<th>" & Range("C1").Value & "</th>" _
& "<th>" & Range("D1").Value & "</th>" _
& "<th>" & Range("E1").Value & "</th>" _
& "<th>" & Range("F1").Value & "</th>" _
& "<th>" & Range("G1").Value & "</th>" _
'& "<th>" & Range("H1").Value & "</th>" _
'& "<th>" & Range("I1").Value & "</th>" _

'Check to see if column G = 'yes' and skip mail if it does
For Each cell In Rng
If cell.Value <> "" Then
If Not cell.Offset(0, 2).Value = "yes" Then


NmeRow = cell.Row

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.createitem(0)

MailTo = cell.Value 'column E
mailcc = cell.Offset(0, -1).Value
MailSubject = "Weekly Work Issue" & "-" & cell.Offset(0, -4).Value & "-" & cell.Offset(0, -8).Value


'Create MailBody table row for first row
MailBody = "<tr>" _
& "<td>" & cell.Offset(0, -8).Value & "</td>" _
& "<td>" & cell.Offset(0, -7).Value & "</td>" _
& "<td>" & cell.Offset(0, -6).Value & "</td>" _
& "<td>" & cell.Offset(0, -5).Value & "</td>" _
& "<td>" & cell.Offset(0, -4).Value & "</td>" _
& "<td>" & cell.Offset(0, -3).Value & "</td>" _
& "<td>" & cell.Offset(0, -2).Value & "</td>" _
& "</tr>"

'Second loop checks the email addresses of all cells following the current cell in the first loop.
'Yes will be appended on any duplicate finds and another row added to the mailbody table
For Each dwn In Rng.Offset(NmeRow - 1, 0)



If dwn.Value = cell.Value Then

'Create additional table row for each extra row found
AddRow = "<tr>" _
& "<td>" & dwn.Offset(0, -8).Value & "</td>" _
& "<td>" & dwn.Offset(0, -7).Value & "</td>" _
& "<td>" & dwn.Offset(0, -6).Value & "</td>" _
& "<td>" & dwn.Offset(0, -5).Value & "</td>" _
& "<td>" & dwn.Offset(0, -4).Value & "</td>" _
& "<td>" & dwn.Offset(0, -3).Value & "</td>" _
& "<td>" & dwn.Offset(0, -2).Value & "</td>" _
& "</tr>"

dwn.Offset(0, 2).Value = "yes"
MailBody = MailBody & AddRow 'column A

End If
' Clear additional table row variable ready for next
AddRow = ""
Next

MsgStr = "<p>Hi " & cell.Offset(0, -8).Value & "," & vbNewLine & "please see below an overview of your work Tuesday to Friday. Your final schedule will be emailed to you the day before the appointments are due to take place." & "<br><br>" & vbNewLine & cell.Offset(0, 1).Value & "<br><br>" _



With OutMail

.To = MailTo
.CC = mailcc
.Subject = MailSubject
.HTMLBody = PgStart & MsgStr & tableHdr & MailBody & "</table></body></html>" & "<br><br>" & vbNewLine & "Any issues, please contact your FTL." & "<br><br>" & vbNewLine & "Many Thanks" & "<br><br>" & vbNewLine & "Complex Team"
.Send
'send
End With

cell.Offset(0, 2).Value = "yes"

End If
End If


MailTo = ""
MailSubject = ""
MailBody = ""
Next

'Clear 'yes' from all appended cells in column H
Range("K2:K" & x + 1).ClearContents
End Sub
Click to expand...
This is the bit i am trying to put in the other code
VBA Code: 
    v = Range("A2:A" & lRow).Resize(, 11).Value
        For i = LBound(v) To UBound(v)
            If v(i, 11) <> "yes" Then
                Set rName = Sheets("Email Links").Range("A:A").Find(v(i, 1), LookIn:=xlValues, lookat:=xlWhole)
                If Not rName Is Nothing Then
                    If Not .exists(v(i, 1)) Then
                        .Add v(i, 1), Nothing
                        Range("A1").CurrentRegion.AutoFilter 1, v(i, 1)
                        Set rng = Range("A1:G" & lRow).SpecialCells(xlCellTypeVisible)
                        End With
                    End If
                Else
                    If MsgBox(v(i, 1) & " was not found. Do you wish to continue?", vbYesNo) = vbNo Then
                        Range("A1").AutoFilter
                        Exit Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

E
  • Question Question
VBA code clean up
Replies
9
Views
593
mumps
mumps
J
  • Question Question
Send bulk email attachment error
Replies
3
Views
115
JOHATUP
J
T
  • Solved
Help with VBA Code in Excel
Replies
2
Views
351
tixarah
T
E
  • Question Question
Adding a custom message.
Replies
1
Views
671
Micron
M
S
  • Solved
Referencing a Data Range in Sheet2 whilst being in Sheet3
Replies
4
Views
280
MARK858
MARK858

Forum statistics

Threads
1,224,832
Messages
6,181,234
Members
453,026
Latest member
cknader

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top