subroutine

Trevor3007

Trevor3007

Well-known Member
Joined
Jan 26, 2017
Messages
675
Office Version
  1. 365
Platform
  1. Windows
In the 'red'code below , if the user chooses N, I need it to go to the 'green' code bit at the bottom just before the 'exit' so the cursor ends up in cell A2 & a msgbox dispalys to prompt the user with a message of advise. It works fine if Y is chosen?

Sub importdata()
'
' importdata Macro
''
Workbooks.Open Filename:="C:\Users\xyz\desktop\info\coffe_data.xlsx"
Range("A2:H3007").Select
Selection.Copy
Windows("test_lookup.xlsm").Activate
Range("A2").Select
ActiveSheet.Paste
Windows("lookup_data.xlsx").Activate
Application.CutCopyMode = False
ActiveWindow.Close
If MsgBox("Do You Want A Border Placed Around This Worksheet", vbYesNo + vbQuestion) = vbNo Then Exit Sub
 Range("A1:N3007").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range("A2").Select
Range("I1:I3007").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("A2").Select
MsgBox "End Of Macro,Please Save The File To An Area Of your Choice If You Are Finished or Rerun Again."
End Sub

Any suggs?

KR
Trevor3007
 

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().
Sort by date Sort by votes
Instead of testing if it is no test if it is yes. The code between the if then and end if will only run if yes is selected. if no is selected it will run the code after the end if.
Code: 
If MsgBox("Do You Want A Border Placed Around This Worksheet", vbYesNo + vbQuestion) = vbYes ThenRange("A1:N3007").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range("A2").Select
Range("I1:I3007").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
End If
Range("A2").Select
MsgBox "End Of Macro,Please Save The File To An Area Of your Choice If You Are Finished or Rerun Again."
 
Upvote 0
Hi Scott T ,

many thanks for getting back to me .
I am a bit of newbie to this VB thing & thought I'd could just copy & paste into my code..but got error message!

Could you do the do for me & then I can see the errors of my ways...

many thanks again.
Trev:cool:r3007
 
Upvote 0
Try
Code: 
Sub importdata()'
' importdata Macro
''
Workbooks.Open Filename:="C:\Users\xyz\desktop\info\coffe_data.xlsx"
Range("A2:H3007").Select
Selection.Copy
Windows("test_lookup.xlsm").Activate
Range("A2").Select
ActiveSheet.Paste
Windows("lookup_data.xlsx").Activate
Application.CutCopyMode = False
ActiveWindow.Close
If MsgBox("Do You Want A Border Placed Around This Worksheet", vbYesNo + vbQuestion) = vbYes Then
    Range("A1:N3007").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
    End With
    Range("A2").Select
    Range("I1:I3007").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
End If
Range("A2").Select
MsgBox "End Of Macro,Please Save The File To An Area Of your Choice If You Are Finished or Rerun Again."
End Sub
 
Upvote 0
Scott T said:
Try
Code: 
Sub importdata()'
' importdata Macro
''
Workbooks.Open Filename:="C:\Users\xyz\desktop\info\coffe_data.xlsx"
Range("A2:H3007").Select
Selection.Copy
Windows("test_lookup.xlsm").Activate
Range("A2").Select
ActiveSheet.Paste
Windows("lookup_data.xlsx").Activate
Application.CutCopyMode = False
ActiveWindow.Close
If MsgBox("Do You Want A Border Placed Around This Worksheet", vbYesNo + vbQuestion) = vbYes Then
    Range("A1:N3007").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
    End With
    Range("A2").Select
    Range("I1:I3007").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
End If
Range("A2").Select
MsgBox "End Of Macro,Please Save The File To An Area Of your Choice If You Are Finished or Rerun Again."
End Sub
Click to expand...



Thanks Scott T,

works a treat. Oh, am would like to protect the sheet after it does its thing, but when I do put 'protection on' the macro buttons don't work? Any suggs


Trevor3007
 
Upvote 0
If you protect the sheet in the macro you have to unprotect the sheet so that the macro can do thins then protect the sheet again.

At the beginning of the code, right after you open the file put this line to unprotect
Code: 
Thisworkbook.Worksheets ("put the sheet name here").Unprotect ("password")

At the end right before end sub put this to protect the sheet
Code: 
ThisWorkbook.Worksheets ("put sheet name here").Protect ("yourpassword")
 
Upvote 0
Scott T said:
If you protect the sheet in the macro you have to unprotect the sheet so that the macro can do thins then protect the sheet again.

At the beginning of the code, right after you open the file put this line to unprotect
Code: 
Thisworkbook.Worksheets ("put the sheet name here").Unprotect ("password")

At the end right before end sub put this to protect the sheet
Code: 
ThisWorkbook.Worksheets ("put sheet name here").Protect ("yourpassword")
Click to expand...


thanks Scott T,

followed as you instructed but computer says no :{ as soon as I hit the applicable macro button , a 'runtime error' appears & the debug highlights '
Thisworkbook.Worksheets ("put the sheet name here").Unprotect ("password").'

sorry :{
 
Upvote 0
Did you change the put "the sheet name here" to your sheet name?
You may need to change ThisWorkbook do specify the workbook depending on workbook is protected.
 
Upvote 0
Scott T said:
Did you change the put "the sheet name here" to your sheet name?
You may need to change ThisWorkbook do specify the workbook depending on workbook is protected.
Click to expand...





Hi thanks for your reply scott t





Sub importdata()
'
' importdata Macro
'lap_lookup ("info").Unprotect ("")

Selection.Borders(xlDiagonalDown).LineStyle = xlNone

lap_lookup ("info").protect ("")




text in green is what I put in (don't need a password & therefore presumed ("") was correct)?


text in red is the error that VB highlighted in yellow.


could you just add this to the code I sent to you & I can see the error of my ways ( yet again )?

thank you very much.

KR
Trevor3007
 
Upvote 0
If you are not using a password then you can omit it something like this
Code: 
Workbooks("coffe_data.xlsx").Sheets("info").Protect

what is lap_lookup?
 
Upvote 0
You must log in or register to reply here.

Similar threads

K
  • Solved
formating question
Replies
3
Views
312
Micron
M
L
  • Locked
  • Question Question
Help Cleaning Up Code
Replies
2
Views
584
RoryA
RoryA
P
  • Question Question
Issue with button not running in spread sheet only in test mode
Replies
1
Views
369
6StringJazzer
6StringJazzer
K
  • Solved
create a button that do actions
2 3
Replies
22
Views
1K
kerm007
K
J
  • Question Question
Issue with Macros and renaming files
Replies
6
Views
1K
kevin9999
K

Forum statistics

Threads
1,223,910
Messages
6,175,318
Members
452,634
Latest member
cpostell

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