Issues with my SelectionChange - excel-2007

I can't seem to get it to work right
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim LastRow As Long
If Not Intersect(Target, Range("C7,D7,E7,F7,G7,C8,D8,E8,F8,G8,C9,D9,E9,F9,G9,C10,D10,E10,F10,G10,C11,D11,E11,F11,G11")) Is Nothing Then
Application.EnableEvents = False
With Selection.Borders(xlDiagonalDown)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThick
Application.EnableEvents = True
End With
With Selection.Borders(xlDiagonalUp)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.249977111117893
End With
End If
End Sub

Your code does work (or at least, tell us what doesn't).
Please be sure to put this code in a Worksheet Module:
Select the Worksheet where you want the code to get applied
Right-click on the Worksheet Name
Click on View Code...
Paste your code
[EDIT] You should probably reactivate the Events at the end of your code:
Application.EnableEvents = True

Related

Activate/Deactivate Hyperlinks

This is my first go at asking a question so apologies to all if I haven't given enough info or messed up in some other way!
I have a sheet with areas which are hidden until required by the user. These are called for with a button and another button to hide them all again when creating a new workbook. The hidden areas each contain a hyperlink (these take the user to other sheets in the workbook) in a text box (this allows the hyperlink to work when the sheet is protected). My problem is that the hyperlinks are still active and the cursor shows a hand when over these hyperlinks even when they are hidden. How can I deactivate a hyperlink while it is hidden using VBA or a macro? Any assistance will be very welcome. Thanks
The sections on the sheet are hidden/shown by code which changes the color to the same as the background I didn't want to close columns or rows as I wanted to maintain the header and size of the sheet.
All the coding works for what I have done but have spent a long time trying to find an answer to my question without success. The hidden sections are up to 12 blocks of data entry cells which will be used dependant on the users project requirements.
A sections of the code I have placed below are for making block 12 appear and then next routine is for hiding all the blocks except number 1. The next is a sub routine that I have for hiding the text box of block number 2. I decided to change from having the hyperlink in a cell to a text box to allow the sheet to be protected but still use the hyperlinks for view only purposes. I have added the code for the routine for hiding the text box and it was this I was experimenting with to disable the hyperlink. However the only bit of code I could find that looked like it might do the job was EnableEvents but I couldn't achieve what I wanted with that, so here I am.
I'm sure you can see that I am note a programmer I borrow bits of code and stick them together and play with it until it works but I've run out of bits to stick and time to play.
Sub AppearCompOp12()
'
' AppearCompOp12 Macro
'
'
Range("ar22:bd28").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
Range("AR22").Select
Selection.Font.Size = 16
With Selection.Font
.Color = -65536
.TintAndShade = 0
End With
End Sub
Sub ResetCapMSADashboard()
'
' ResetCapMSADashboard Macro
'
'
Range( _
"P6:AB12,AD6:AP12,AR6:BD12,AR14:BD20,AR22:BD28,AD14:AP20,AD22:AP28,P14:AB20,B14:N20,B22:N28,P22:AB28" _
).Select
With Selection.Font
.Color = RGB(217, 217, 217)
End With
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ThemeColor = 1
.TintAndShade = -0.14996795556505
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ThemeColor = 1
.TintAndShade = -0.14996795556505
.Weight = xlThin
End With
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ThemeColor = 1
.TintAndShade = -0.14996795556505
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ThemeColor = 1
.TintAndShade = -0.14996795556505
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ThemeColor = 1
.TintAndShade = -0.14996795556505
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ThemeColor = 1
.TintAndShade = -0.14996795556505
.Weight = xlThin
End With
Range("BG2:BG26").Select
Selection.ClearContents
Range("J7").Select
End Sub
Sub RecolourTB2()
'
' Change text box & text to background colourbox
'
ActiveSheet.Shapes.Range(Array("TextBox 9")).Select
With Selection.ShapeRange.TextFrame2.TextRange.Font.Fill
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorBackground1
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = -0.25
.Transparency = 0
.Solid
End With
Range("P10:W10").Select
ActiveSheet.Shapes.Range(Array("TextBox 9")).Select
EnableEvents = False
With Selection.ShapeRange.TextFrame2.TextRange.Font.Fill
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorBackground1
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = -0.150000006
.Transparency = 0
.Solid
End With
Range("P9:W9").Select
End Sub

draw borders vba excel on button with space

Hi I'm new with VBA need some help here if possible. I am trying to make 3 buttons, each button draws a top-line and a bottom line(i'll provide the excel file too):
the first button draws inside of 5 rows a top and a bottom line.
the second button draws inside of 10 rows a top and a bottom line.
the third button draws inside of 20 rows a top and a bottom line.
What I'm trying to achieve:
every time I press button 1 to keep count if already has been drawn the borders, if I press twice in a row button 1 to keep count if I already have drawn the borders, and draw again after keeping a space of 2 rows in between....Same if I would've pressed Button1, then Button 2. Or button 3.
..I am new with VBA I would love some help....
ub Macro2()
'
' Macro2 Macro
'
'
Range("A13:BD23").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThick
End With
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("A27").Select
ActiveWindow.SmallScroll Down:=12
Range("A27").Select
End Sub
Sub Macro1()
'
' Macro1 Macro
'
'
Range("A4:J8").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThick
End With
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("C9").Select
End Sub
Sub Macro3()
'
' Macro3 Macro
'
'
Range("A26:P46").Select
ActiveWindow.SmallScroll Down:=-6
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThick
End With
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("G34").Select
ActiveWindow.SmallScroll Down:=-15
End Sub
DL LINK:
https://mega.nz/#!sgkVATKQ!k-Nq5gpKf4NfW2afEM8wpg_T5RFqT6y2_iqH7lDTM40
Not sure I completely followed your description, but try this:
EDIT - added a way to reset the "last range" so you can start over.
Option Explicit
Sub DoFive()
DoBorders Range("A4:J8")
End Sub
Sub DoTen()
DoBorders Range("A13:BD23")
End Sub
Sub DoTwenty()
DoBorders Range("A26:P46")
End Sub
'this is called to reset the starting point to whatever is passed.
Sub ResetStart()
DoBorders Nothing
End Sub
Sub DoBorders(rng As Range)
Dim useRange As Range
Static lastRange As Range
'handle resetting the "last range"
If rng Is Nothing Then
Set lastRange = Nothing
Exit Sub
End If
If lastRange Is Nothing Then
Set useRange = rng
Else
Set useRange = lastRange.Cells(1).Offset(lastRange.Rows.Count + 2, 0) _
.Resize(rng.Rows.Count, rng.Columns.Count)
End If
Set lastRange = useRange 'save for next call
With useRange
.Borders.LineStyle = xlNone 'remove all borders
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThick
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThick
End With
End With
End Sub

Row selection and putting border using VBA macros in excel

I Need to find the non empty rows in a sheet from row 13 and put a top thick border to the selected non empty rows till the last used rows of the sheet. from the column C i need to find the non empty row. I tried this code but it is not working. can u plz help me out
Sub rowfind3()
Dim cell As Range
Dim r1 As Range
For Each cell In ActiveSheet.Range("C:C")
If (cell.Value <> "") Then
Set r1 = Range("A" & ActiveCell.Row & ":AV" & ActiveCell.Row)
r1.Select
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 = xlMedium
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
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
End If
Next cell
End Sub
In this code only the first row the border is displayed, however for the successive rows the border is not coming.
Also i tried another code for the above scenario, but the same first row is only the border is displayed.
Sub rowfind1()
'
' rowfind Macro
'
'
Dim r1 As Range
Dim lr As Variant
Dim i As Integer
lr = ActiveSheet.UsedRange.Rows.Count
i = 0
For i = 13 To lr - 11
If (Not (IsEmpty(Cells(i, 3).Value))) Then
Set r1 = Range("A" & ActiveCell.Row & ":AV" & ActiveCell.Row)
r1.Select
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 = xlMedium
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
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
End If
Next i
End Sub
Firstly, no need to use selection. All that ends up doing is potentially confusing the code (as in this case). Secondly, theres no need to re-declare the range inside the loop. Thats what the loop is there for.
Here is how it should look:
Sub rowfind3()
Dim cell As Range
For Each cell In ActiveSheet.Range("C:C")
If (cell.Value <> "") Then
With cell.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With cell.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With cell.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With cell.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
End If
Next cell
End Sub
I would look at changing the Activesheet to reference the actual sheet you want it on and only look at the UsedRange as well to speed it up a bit, but that code will now at least get you there.
Addendum based on Comments clarification:
lr = ActiveSheet.Cells(ActiveSheet.Rows.Count, "C").End(xlUp).Row
With ActiveSheet.Range("C13:C" & lr)
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
.Borders(xlInsideHorizontal).LineStyle = xlNone
End With
Did you consider to use Conditional Formatting? For example on Columns $A:$AV formula is =$A1<>"", in formatting choose borders.

How do I sort this Macro out, so it selects the next row automatically

I am making a Movie Database on Excel, I have set it all up. Its working fine, i decided to add a Data entry form which will allow the user to input movie details in a form and automatically using a macro it would then move this data to a separate Worksheet with all my movies in. I have managed to record all this step and it works fine however it overwrites data and only uses the row that I pasted it to which was 'A47'. I now want to know how to edit the code so it changes to the next row if data is already available in this row. Another thing to note is that my macro also formats that selection, so that would need changing too. The formatting basically changes certain cells to be bold and text alignment. I will attach the code so you can see what I'm talking about. Also the code at the end deletes the data in the data entry form so its fresh for another entry.
Sorry I'm new to this all, I have looked around but no one has a similar problem as mine.
Any help would be appreciated.
Thanks
Sub SubmitMovie()
'
' SubmitMovie Macro
'
'
Range("K9,K11,K13,K15,K17,K19,K21").Select
Range("K21").Activate
Selection.Copy
Sheets("MovieList").Select
Range("A74:G74").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Range("B74").Select
Application.CutCopyMode = False
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("D74").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A74:G74").Select
Range("G74").Activate
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
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
Sheets("Add New Movie").Select
Range("K9").Select
ActiveCell.FormulaR1C1 = ""
Range("K11").Select
ActiveCell.FormulaR1C1 = ""
Range("K13").Select
ActiveCell.FormulaR1C1 = ""
Range("K15").Select
ActiveCell.FormulaR1C1 = ""
Range("K17").Select
ActiveCell.FormulaR1C1 = ""
Range("K19").Select
ActiveCell.FormulaR1C1 = ""
Range("K21").Select
ActiveCell.FormulaR1C1 = ""
Range("D28").Select
End Sub
Replace this
Range("K9,K11,K13,K15,K17,K19,K21").Select
Range("K21").Activate
Selection.Copy
Sheets("MovieList").Select
Range("A74:G74").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
with
Dim dest as Range
Activesheet.Range("K9,K11,K13,K15,K17,K19,K21").Copy
'find the first non-empty cell in ColA (from bottom up)
Set dest = Sheets("MovieList").Cells(rows.count,1).End(xlUp).offset(1,0)
dest.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, _
SkipBlanks:= False, Transpose:=True
Welcome to SO.
Since you are new to VBA you have chosen a good way to start learning more by using the macro recorder, but you have already learned that it has its limitations. It doesn't always do things in the most efficent way.
Some pointers on how to improve the script:
Remove all code that you don't know what it does. Most of it should be self explanatory, but if you don't know what it does, chances are you don't need it, because the macro recorder adds lots of uneccessary stuff.
Avoid using Select to navigate the worksheet. It is very inefficient and will slow down your code: tips on how to avoid using select.
There are lots of questions on SO about finding the last used row in order to know where new data can be saved.
Use Option Explicit at the top of each code module to minimize confusion and errors caused by typos etc. It will force you to explicitly declare all variables used, which is a good thing since VBA otherwise will accept all variable names as new variant-types if they haven't been declared before.
If you get stuck on a specific problem - ask questions on that specific problem.
This previous post should help you see some of the concepts/syntax involved in the solution: Loops & Rows
The bottom line is you've run into an issue that macro recorder cannot get you out of. It would be really beneficial for you to take some time to learn about loops, counts and the Cells() function in VBA. Olle and Tim are spot on...especially Tim's "Set dest =" line.
This link shows a good example of loop syntax and may be a help to you on future problems of a similar nature:
Looping Through Ranges

Preventing reset of VBA variables from excel recompile

Private Sub CommandButton2_Click()
Dim TempVar As Integer
TempVar = NumNodes
NumNodes = NumNodes + 1
TempVar = NumNodes
Debug.Print "NumNodes + 1"
Call Node_Button_Duplication
Call Channel_Selection_Duplication
NumNodes = TempVar
Debug.Print "NumNodes = " & NumNodes 'Debug
Debug.Print "TempVar = " & NumNodes 'Debug
End Sub
Public Sub Channel_Selection_Duplication()
Range("Q8:S8").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Range("Q8:S8").Select
ActiveCell.FormulaR1C1 = "Channel Usage Selection"
Range("Q8:S52").Select
Range("Q52").Activate
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Range("Q8:S8").Select
Selection.Interior.ColorIndex = 36
End Sub
Public Sub Node_Button_Duplication()
Worksheets("Topology").Shapes("CommandButton1").Select
Selection.Copy
Worksheets("Topology").Paste
Selection.ShapeRange.IncrementLeft 339#
Selection.ShapeRange.IncrementTop -12.75
End Sub
I'm trying to save the value of NumNodes (a global variable) before calling the 2 subroutines (Node_Button_Duplication and Channel_Selection_Duplication), the first subroutine called copies and pastes a command button in a spreadsheet. This, I believe, recompiles the VBA project and reset (all?) global variables.
I have tried to write to a cell and read back the value from the cell, but this did not work (essentially the same ideas as using a temp variable).
The above code, when run, causes both TempVar and NumNodes to be reset to 1 each run. I am wondering what the best way is to save the variable from being reset?
Try this
Option Explicit
Private Sub CommandButton2_Click()
Dim NumNodes as Long
NumNodes = Sheets("Temp").Range("A1").Value
NumNodes = NumNodes + 1
Sheets("Temp").Range("A1").Value = NumNodes
MsgBox "NumNodes = " & NumNodes
Call Node_Button_Duplication
Call Channel_Selection_Duplication
End Sub
Ensure that you have a sheet Called "Temp"
Now try it.