Skip a line of code if a number is contained in new workbook

D

Dark0Prince

Active Member
Joined
Feb 17, 2016
Messages
433
Code: 
Sub VOPSRELATIVE()
'
' VOPSRELATIVE Macro
'
' Keyboard Shortcut: Ctrl+Shift+R
'
    Number = ActiveSheet.Cells(14, 1)
    lastrow = 13
    For Each c In Range(Cells(14, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1))
        If Number <> c Then Exit For
        lastrow = lastrow + 1
    Next
    If lastrow = 13 Then Exit Sub
    Range("A1:M" & lastrow).Copy
    Workbooks.Add
    ActiveSheet.Paste
    Workbooks("DISP FORM - BLANK.xlsm").Sheets(2).Rows("14:" & lastrow).EntireRow.Delete
    Range("A2").Activate
    Columns("A:L").EntireColumn.AutoFit
    Columns("A:A").Select
    Range("A2").Activate
    Selection.ColumnWidth = 10.5
    Range("F14").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("A7").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveWorkbook.Password = "SECRET"
    Columns(6).EntireColumn.Delete
    Range("A7:K7").Select
    Selection.Copy
End Sub

This code creates a new workbook and pw protects it no matter what client number is contained in the new workbook. I think the best way to do this is to add a sheet in excel that lists all the client numbers that I don't want to be password protected. Then if they exist on the new workbook I want it to skip the line " ActiveWorkbook.Password = "SECRET" ". How can I add this IF statement?
 
Sort by date Sort by votes
Dark0Prince said:
I'm guesing that this is what is happening but when I used the msg boxes it showed me both client numbers and they matched but it was comparing the new sheet to the DISP form not the DISPform to the A14 on the new sheet.
Click to expand...

I'm not too sure what you mean by that, if the variables are being held in the wrong values just switch the addresses. The variable ClientListToSearch should hold your list of numbers that don't need to be password protected in a format separated by a comma i.e 600,888,999,6666.

The variable ClientNumber2SearchFor will hold your single client number that you wish to compare against the list. As far as I can tell you're saying that is entered into A14 on the new sheet, I guessing it'll be sheet1, if so that can be set when you paste into your new sheet as you are setting that as active
Code: 
.....................
If lastrow = 13 Then Exit Sub    Range("A1:M" & lastrow).Copy
    Workbooks.Add
    ActiveSheet.Paste
    ClientNumber2SearchFor =Range("A14").Value


And I'm now assuming your search list is in A1
Code: 
ClientListToSearch = Split(Workbooks("DISPFORM - BLANK.xlsm").Sheets("ShareFile").Range("A1").Value, ",")


So that would give you

Code:
Code: 
Sub VOPSRELATIVE()
'
' VOPSRELATIVE Macro
'
' Keyboard Shortcut: Ctrl+Shift+R
'
Dim ClientNumber2SearchFor As String
Dim ClientListToSearch As Variant
Dim Found As Boolean


 
ClientListToSearch = Split(Workbooks("DISPFORM - BLANK.xlsm").Sheets("ShareFile").Range("A1").Value, ",")
Found = False
'
'


    Number = ActiveSheet.Cells(14, 1)
    lastrow = 13
    For Each c In Range(Cells(14, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1))
        If Number <> c Then Exit For
        lastrow = lastrow + 1
    Next
    If lastrow = 13 Then Exit Sub
    Range("A1:M" & lastrow).Copy
    Workbooks.Add
    ActiveSheet.Paste
    ClientNumber2SearchFor = Range("A14").Value
    Workbooks("DISP FORM - BLANK.xlsm").Sheets(2).Rows("14:" & lastrow).EntireRow.Delete
    Range("A2").Activate
    Columns("A:L").EntireColumn.AutoFit
    Columns("A:A").Select
    Range("A2").Activate
    Selection.ColumnWidth = 10.5
    Range("F14").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("A7").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False




'
'
For Each clientNumber In ClientListToSearch


answer = MsgBox("Checking client number " & Replace(ClientNumber2SearchFor, Chr(34), "") & " against " & Replace(clientNumber, Chr(34), "") & " from your list. Carry on checking?", vbYesNo + vbQuestion, "Empty Sheet")
If answer = vbNo Then Exit For


If Trim(Replace(ClientNumber2SearchFor, Chr(34), "")) = Trim(Replace(clientNumber, Chr(34), "")) And Trim(Replace(clientNumber, Chr(34), "")) <> "" Then
Found = True
Exit For
End If


Next clientNumber


If Found = False Then MsgBox "not found" ' we can change this to protect the sheet later
If Found = True Then MsgBox "found"
'


    ActiveWorkbook.Password = "SECRET"
    Columns(6).EntireColumn.Delete
    Range("A7:K7").Select
    Selection.Copy
End Sub


 
Last edited:
Upvote 0

Excel Facts

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.
This code here fixed it. With a little trial and error I managed to write it correctly at the bottom. Thanks for your help this is now resolved.
Code: 
If Found = False Then Exit Sub
Else
    ActiveWorkbook.Password = "SECRET"

End If
End Sub
 
Upvote 0
No problem, good to see you've sorted it. I was under the impression you were skipping the password protection if the client number was found, your code does the opposite. I was going to suggest amending the line

Code: 
[COLOR=#333333]If Found = False Then MsgBox "not found" ' we can change this to protect the sheet later[/COLOR]

to

Code: 
[COLOR=#333333]If Found = False Then [/COLOR][COLOR=#333333]ActiveWorkbook.Password = "SECRET"[/COLOR]

and then deleting or commenting out all the debugging stuff with Msgboxes. If it's doing what you wanted then all good, otherwise it's only a case of flipping it to True from False.
 
Upvote 0
This is going to make me rip hair off my head. Once again the code just stopped working I'm going to show you the whole thing and hope it's something I just fat fingered but the code isn't ever false again.
Code: 
Sub VOPSRELATIVE()
'
' VOPSRELATIVE Macro
'
' Keyboard Shortcut: Ctrl+Shift+R
'
Dim ClientNumber2SearchFor As String
Dim ClientListToSearch As Variant
Dim Found As Boolean
Dim Path As String
Dim filename As String
Path = "S:\Personal Folders\VOP's 3036\" 'CHANGE LOCATION BASED ON DISPO
filename = Range("F14")
 
 
ClientListToSearch = Split(Workbooks("DISPFORM - BLANK.xlsm").Sheets("ShareFile").Range("A1").Value, ",")
Found = False

    Number = ActiveSheet.Cells(14, 1)
    lastrow = 13
    For Each c In Range(Cells(14, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1))
        If Number <> c Then Exit For
        lastrow = lastrow + 1
    Next
    If lastrow = 13 Then Exit Sub
    Range("A1:M" & lastrow).Copy
    Workbooks.Add
    ActiveSheet.Paste
    ClientNumber2SearchFor = Range("A14").Value
    Workbooks("DISPFORM - BLANK.xlsm").Sheets(2).Rows("14:" & lastrow).EntireRow.Delete
    Range("A2").Activate
    Columns("A:L").EntireColumn.AutoFit
    Columns("A:A").Select
    Range("A2").Activate
    Selection.ColumnWidth = 10.5
    Range("F14").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("A7").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Columns(6).EntireColumn.Delete
       
If Trim(Replace(ClientNumber2SearchFor, Chr(34), "")) = Trim(Replace(clientNumber, Chr(34), "")) And Trim(Replace(clientNumber, Chr(34), "")) <> "" Then
Found = True
If Found = False Then ActiveWorkbook.Password = "secret"
End If
 ActiveWorkbook.SaveAs Path & filename & ".xlsx", FileFormat:=51
End Sub
 
Upvote 0
It works perfectly until I try to get rid of the msg boxes. that appear after each client number it's checking. here is the working code before I deleted the msg boxes.
Code: 
Sub VOPSRELATIVE()
'
' VOPSRELATIVE Macro
'
' Keyboard Shortcut: Ctrl+Shift+R
'
Dim ClientNumber2SearchFor As String
Dim ClientListToSearch As Variant
Dim Found As Boolean
Dim Path As String
Dim filename As String
Path = "S:\Personal Folders\VOP's 3036\" 'CHANGE LOCATION BASED ON DISPO
filename = Range("F14")


 
ClientListToSearch = Split(Workbooks("DISPFORM - BLANK.xlsm").Sheets("ShareFile").Range("A1").Value, ",")
Found = False
'
'


    Number = ActiveSheet.Cells(14, 1)
    lastrow = 13
    For Each c In Range(Cells(14, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1))
        If Number <> c Then Exit For
        lastrow = lastrow + 1
    Next
    If lastrow = 13 Then Exit Sub
    Range("A1:M" & lastrow).Copy
    Workbooks.Add
    ActiveSheet.Paste
    ClientNumber2SearchFor = Range("A14").Value
    Range("A2").Activate
    Columns("A:L").EntireColumn.AutoFit
    Columns("A:A").Select
    Range("A2").Activate
    Selection.ColumnWidth = 10.5
    Range("F14").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("A7").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Columns(6).EntireColumn.Delete
    Range("A7:K7").Select
    Selection.Copy
Workbooks("DISPFORM - BLANK.xlsm").Sheets(2).Rows("14:" & lastrow).EntireRow.Delete



'
'
For Each clientNumber In ClientListToSearch


answer = MsgBox("Checking client number " & Replace(ClientNumber2SearchFor, Chr(34), "") & " against " & Replace(clientNumber, Chr(34), "") & " from your list. Carry on checking?", vbYesNo + vbQuestion, "Empty Sheet")
If answer = vbNo Then Exit For


If Trim(Replace(ClientNumber2SearchFor, Chr(34), "")) = Trim(Replace(clientNumber, Chr(34), "")) And Trim(Replace(clientNumber, Chr(34), "")) <> "" Then
Found = True
Exit For
End If


Next clientNumber


If Found = False Then ActiveWorkbook.Password = "SECRET"
If Found = True Then MsgBox "found"
'
ActiveWorkbook.SaveAs Path & filename & ".xlsx", FileFormat:=51

    

End Sub
 
Upvote 0
Dark0Prince said:
It works perfectly until I try to get rid of the msg boxes. that appear after each client number it's checking. here is the working code before I deleted the msg boxes.
Code: 
Sub VOPSRELATIVE()
'
' VOPSRELATIVE Macro
'
' Keyboard Shortcut: Ctrl+Shift+R
'
Dim ClientNumber2SearchFor As String
Dim ClientListToSearch As Variant
Dim Found As Boolean
Dim Path As String
Dim filename As String
Path = "S:\Personal Folders\VOP's 3036\" 'CHANGE LOCATION BASED ON DISPO
filename = Range("F14")


 
ClientListToSearch = Split(Workbooks("DISPFORM - BLANK.xlsm").Sheets("ShareFile").Range("A1").Value, ",")
Found = False
'
'


    Number = ActiveSheet.Cells(14, 1)
    lastrow = 13
    For Each c In Range(Cells(14, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1))
        If Number <> c Then Exit For
        lastrow = lastrow + 1
    Next
    If lastrow = 13 Then Exit Sub
    Range("A1:M" & lastrow).Copy
    Workbooks.Add
    ActiveSheet.Paste
    ClientNumber2SearchFor = Range("A14").Value
    Range("A2").Activate
    Columns("A:L").EntireColumn.AutoFit
    Columns("A:A").Select
    Range("A2").Activate
    Selection.ColumnWidth = 10.5
    Range("F14").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("A7").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Columns(6).EntireColumn.Delete
    Range("A7:K7").Select
    Selection.Copy
Workbooks("DISPFORM - BLANK.xlsm").Sheets(2).Rows("14:" & lastrow).EntireRow.Delete



'
'
For Each clientNumber In ClientListToSearch


answer = MsgBox("Checking client number " & Replace(ClientNumber2SearchFor, Chr(34), "") & " against " & Replace(clientNumber, Chr(34), "") & " from your list. Carry on checking?", vbYesNo + vbQuestion, "Empty Sheet")
If answer = vbNo Then Exit For


If Trim(Replace(ClientNumber2SearchFor, Chr(34), "")) = Trim(Replace(clientNumber, Chr(34), "")) And Trim(Replace(clientNumber, Chr(34), "")) <> "" Then
Found = True
Exit For
End If


Next clientNumber


If Found = False Then ActiveWorkbook.Password = "SECRET"
If Found = True Then MsgBox "found"
'
ActiveWorkbook.SaveAs Path & filename & ".xlsx", FileFormat:=51

    

End Sub
Click to expand...

The code If Found = False Then ActiveWorkbook.Password = "secret" needs to be outside of the For Each loop

Try

Code: 
Sub VOPSRELATIVE()
'
' VOPSRELATIVE Macro
'
' Keyboard Shortcut: Ctrl+Shift+R
'
Dim ClientNumber2SearchFor As String
Dim ClientListToSearch As Variant
Dim Found As Boolean
Dim Path As String
Dim filename As String
Path = "S:\Personal Folders\VOP's 3036\" 'CHANGE LOCATION BASED ON DISPO
filename = Range("F14")


 
ClientListToSearch = Split(Workbooks("DISPFORM - BLANK.xlsm").Sheets("ShareFile").Range("A1").Value, ",")
Found = False
'
'


    Number = ActiveSheet.Cells(14, 1)
    lastrow = 13
    For Each c In Range(Cells(14, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1))
        If Number <> c Then Exit For
        lastrow = lastrow + 1
    Next
    If lastrow = 13 Then Exit Sub
    Range("A1:M" & lastrow).Copy
    Workbooks.Add
    ActiveSheet.Paste
    ClientNumber2SearchFor = Range("A14").Value
    Range("A2").Activate
    Columns("A:L").EntireColumn.AutoFit
    Columns("A:A").Select
    Range("A2").Activate
    Selection.ColumnWidth = 10.5
    Range("F14").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("A7").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Columns(6).EntireColumn.Delete
    Range("A7:K7").Select
    Selection.Copy
Workbooks("DISPFORM - BLANK.xlsm").Sheets(2).Rows("14:" & lastrow).EntireRow.Delete



'
'
For Each clientNumber In ClientListToSearch

If Trim(Replace(ClientNumber2SearchFor, Chr(34), "")) = Trim(Replace(clientNumber, Chr(34), "")) And Trim(Replace(clientNumber, Chr(34), "")) <> "" Then
Found = True
Exit For
End If

Next clientNumber


If Found = False Then ActiveWorkbook.Password = "SECRET"

ActiveWorkbook.SaveAs Path & filename & ".xlsx", FileFormat:=51

    

End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

G
  • Question
Workbook formulas copied with Sheet references in new Workbook
Replies
0
Views
24
GK039
G
L
  • Locked
  • Question
Help Cleaning Up Code
Replies
2
Views
367
RoryA
RoryA
U
  • Question
VBA to look for an open file
Replies
1
Views
528
NateSC
NateSC
M
  • Question
I need help with this code to modify the data into a table using Userform for VBA Excel (I want to do the range unlimited instead to do C7:C80000
Replies
5
Views
484
Dan_W
D
T
  • Question
VBA code to export specific variably named tabs to new workbook?
Replies
2
Views
447
thebigejr
T

Forum statistics

Threads
1,216,028
Messages
6,128,399
Members
449,447
Latest member
M V Arun

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