Transferring VBA code to another cell

J

Joek88

New Member
Joined
Aug 17, 2023
Messages
37
Office Version
  1. 2021
Platform
  1. Windows
Ok, I have wrote a section of code that is fairly long and includes many different cells. My question is this: Can I use the VBA code that I have written and push that code to another cell? I do not just want to simply copy and paste the logic into a cell, but I want the logic to be changed to look a the cells and reformat all the cells to match the new location.

So here is part of my VBA code below. It basically consist of cell D21 with a dropdown selection of 1,2, or 3. It merges and changes cells based on the selection made in the dropdown. However, I want to move the "logic" part of it to D28. Doing this the "old fashion" way, I would have to go through the entire code and change each cell to it's apporiate new location. This is EXTREMELY time consuming and leads to alot of error. There HAS to be an easier way to achieve this. D28 also has the exact dropdown as D21. I want the code to change based on the new location. So this is why a simple copy and paste will not work. Can this be done or am I dreaming? I can provide my entire code if necessary.

Private Sub HandleCase1()

' Merges and unmerges cells based on Case1 being selected

Range("C21:C26").merge
Range("C21").Value = "-"
Range("C21:C26").Borders(xlEdgeBottom).linestyle = xlContinuous
Range("C28:C33").merge
Range("C28").Value = "-"
Range("C28:C33").Borders(xlEdgeTop).linestyle = xlContinuous
Range("C28:C33").Borders(xlEdgeBottom).linestyle = xlContinuous
Range("C35:C40").merge
Range("C35").Value = "-"
Range("C35:C40").Borders(xlEdgeTop).linestyle = xlContinuous
Range("D21:D33").UnMerge
Range("D21:D26").merge
Range("D27").Interior.ColorIndex = xlNone
Range("D21:D26").Borders(xlEdgeBottom).linestyle = xlContinuous
Range("D28:D33").Borders(xlEdgeTop).linestyle = xlContinuous
Range("D28:D33").merge
If Range("D28").Value = "" Then Range("D28").Value = 1
Range("D34").Interior.ColorIndex = xlNone
Range("D35:D40").merge
Range("D28:D33").Borders(xlEdgeBottom).linestyle = xlContinuous
Range("D28:D33").Borders(xlEdgeTop).linestyle = xlContinuous
Range("D35:D40").Borders(xlEdgeTop).linestyle = xlContinuous
If Range("D35").Value = "" Then Range("D35").Value = 1
 
Sort by date Sort by votes
Ok this all works now that I have it in the same Sub. However, my cells are not correctly merging back to their original state once changed from 3 to 1 dropdown. I can send you the code if you want to comb through what I have so far.
 
Upvote 0

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).
Joek88 said:
Ok this all works now that I have it in the same Sub. However, my cells are not correctly merging back to their original state once changed from 3 to 1 dropdown. I can send you the code if you want to comb through what I have so far.
Click to expand...
Just post the code back here, but be sure to use Code Tags, as directed here: How to Post Your VBA Code

Also, show me some screen prints of an example that is not working (what it happening/what should happen).
 
Upvote 0
Joe4,

So I am finally back on this after a pretty long break. I apologize but I still need some help with this. I have a attached the code so you can get an idea what it is doing. It is SUPER lengthy and will be condensed later but I want you to see what the code is actually doing.

So in the previous text within this post, my objective was this: when D22 was changed to 1,2,or 3 from the droplist it would merge cells together. I want this same logic to work on D29, D36, D43, D50, until it reaches D267. The code that I attached only works for cell D22. I basically want to loop the entire code so that it works for D29, D36, and so on.

When a "1" is selected in cell D22 it will show the following:
1710168662782.png


When a "2" is selected in cell D22 it will merge and show the following:
1710168803695.png


When a "3" is selected in cell D22 it will merge and show the following:
1710168855472.png




VBA Code: 
Private Sub sub4(ByVal Target As Range)
    If (Target.Address = "$D$22") And IsNumeric(Target.Value) Then
        Application.DisplayAlerts = False

        ' Unmerge cells before handling each case
        Range("C22:C40").UnMerge
        Range("D22:D40").UnMerge
        Range("C27:C28").Interior.ColorIndex = xlNone
        Range("C34:C35").Interior.ColorIndex = xlNone

        Select Case Target.Value
            Case 1
                HandleCase1
            Case 2
                HandleCase2
            Case 3
                HandleCase3
                
        End Select

        Application.DisplayAlerts = True
    End If
End Sub
   


Private Sub HandleCase1()
    
    ' Merges and unmerges cells based on Case1 being selected
    
    Range("C22:C26").Merge
    Range("C22").Value = "-"
    Range("C22:C26").Borders(xlEdgeBottom).LineStyle = xlContinuous
    Range("C22:C26").Borders(xlEdgeBottom).Weight = xlMedium
    Range("C22:C26").Borders(xlEdgeLeft).LineStyle = xlContinuous
    Range("C22:C26").Borders(xlEdgeLeft).Weight = xlMedium
    Range("C22:C26").Borders(xlEdgeRight).LineStyle = xlContinuous
    Range("C22:C26").Borders(xlEdgeRight).Weight = xlMedium
    Range("C27:C28").Interior.ColorIndex = xlNone

    
    Range("C29:C33").Merge
    Range("C29").Value = "-"
    Range("C29:C33").Borders(xlEdgeTop).LineStyle = xlContinuous
    Range("C29:C33").Borders(xlEdgeTop).Weight = xlMedium
    Range("C29:C33").Borders(xlEdgeBottom).LineStyle = xlContinuous
    Range("C29:C33").Borders(xlEdgeBottom).Weight = xlMedium
    Range("C29:C33").Borders(xlEdgeLeft).LineStyle = xlContinuous
    Range("C29:C33").Borders(xlEdgeLeft).Weight = xlMedium
    Range("C29:C33").Borders(xlEdgeRight).LineStyle = xlContinuous
    Range("C29:C33").Borders(xlEdgeRight).Weight = xlMedium
    
    Range("C36:C40").Merge
    Range("C36").Value = "-"
    Range("C36:C40").Borders(xlEdgeTop).LineStyle = xlContinuous
    Range("C36:C40").Borders(xlEdgeTop).Weight = xlMedium
    Range("C36:C40").Borders(xlEdgeLeft).LineStyle = xlContinuous
    Range("C36:C40").Borders(xlEdgeLeft).Weight = xlMedium
    Range("C36:C40").Borders(xlEdgeRight).LineStyle = xlContinuous
    Range("C36:C40").Borders(xlEdgeRight).Weight = xlMedium
    Range("C34:C35").Interior.ColorIndex = xlNone

    
    Range("D22:D33").UnMerge
    Range("D22:D26").Merge
    Range("D27:D28").Interior.ColorIndex = xlNone
    Range("D34:D35").Borders(xlEdgeLeft).LineStyle = xlNone
    Range("D34:D35").Borders(xlEdgeRight).LineStyle = xlNone
    
    Range("C27:K28").Borders(xlEdgeLeft).LineStyle = xlNone
    Range("C27:K28").Borders(xlEdgeRight).LineStyle = xlNone
    Range("K27:K28").Borders(xlEdgeLeft).LineStyle = xlNone
    Range("D27:D28").Borders(xlEdgeLeft).LineStyle = xlNone
    Range("D27:D28").Borders(xlEdgeRight).LineStyle = xlNone
    
    Range("C34:K35").Borders(xlEdgeLeft).LineStyle = xlNone
    Range("C34:K35").Borders(xlEdgeRight).LineStyle = xlNone
    Range("K34:K35").Borders(xlEdgeLeft).LineStyle = xlNone
    
    Range("D22:D26").Borders(xlEdgeBottom).Weight = xlMedium
    Range("D22:D26").Borders(xlEdgeBottom).LineStyle = xlContinuous
    Range("D22:D26").Borders(xlEdgeBottom).Weight = xlMedium
    Range("D22:D26").Borders(xlEdgeLeft).LineStyle = xlContinuous
    Range("D22:D26").Borders(xlEdgeLeft).Weight = xlMedium
    Range("D22:D26").Borders(xlEdgeRight).LineStyle = xlContinuous
    Range("D22:D26").Borders(xlEdgeRight).Weight = xlMedium
    Range("D29:D33").Borders(xlEdgeTop).LineStyle = xlContinuous
    Range("D29:D33").Borders(xlEdgeTop).Weight = xlMedium
    Range("D29:D33").Borders(xlEdgeLeft).LineStyle = xlContinuous
    Range("D29:D33").Borders(xlEdgeLeft).Weight = xlMedium
    Range("D29:D33").Borders(xlEdgeRight).LineStyle = xlContinuous
    Range("D29:D33").Borders(xlEdgeRight).Weight = xlMedium
    Range("D29:D33").Merge
    If Range("D29").Value = "" Then Range("D29").Value = 1
    Range("D34:D35").Interior.ColorIndex = xlNone
    
    Range("D36:D40").Merge
    Range("D29:D33").Borders(xlEdgeBottom).LineStyle = xlContinuous
    Range("D29:D33").Borders(xlEdgeBottom).Weight = xlMedium
    Range("D29:D33").Borders(xlEdgeTop).LineStyle = xlContinuous
    Range("D29:D33").Borders(xlEdgeTop).Weight = xlMedium
    Range("D29:D33").Borders(xlEdgeLeft).LineStyle = xlContinuous
    Range("D29:D33").Borders(xlEdgeLeft).Weight = xlMedium
    Range("D29:D33").Borders(xlEdgeRight).LineStyle = xlContinuous
    Range("D29:D33").Borders(xlEdgeRight).Weight = xlMedium
    Range("D36:D40").Borders(xlEdgeTop).LineStyle = xlContinuous
    Range("D36:D40").Borders(xlEdgeTop).Weight = xlMedium
    Range("D36:D40").Borders(xlEdgeLeft).LineStyle = xlContinuous
    Range("D36:D40").Borders(xlEdgeLeft).Weight = xlMedium
    Range("D36:D40").Borders(xlEdgeRight).LineStyle = xlContinuous
    Range("D36:D40").Borders(xlEdgeRight).Weight = xlMedium
    If Range("D36").Value = "" Then Range("D36").Value = 1
    
    Range("E22:K33").UnMerge
    Range("E22:K26").Merge
    Range("E22:K26").Borders(xlEdgeBottom).LineStyle = xlContinuous
    Range("E22:K26").Borders(xlEdgeBottom).Weight = xlMedium
    Range("E22:K26").Borders(xlEdgeLeft).LineStyle = xlContinuous
    Range("E22:K26").Borders(xlEdgeLeft).Weight = xlMedium
    Range("E22:K26").Borders(xlEdgeRight).LineStyle = xlContinuous
    Range("E22:K26").Borders(xlEdgeRight).Weight = xlMedium
    
    Range("E29:K33").Merge
    Range("E29:K33").Borders(xlEdgeTop).LineStyle = xlContinuous
    Range("E29:K33").Borders(xlEdgeTop).Weight = xlMedium
    Range("E29:K33").Borders(xlEdgeLeft).LineStyle = xlContinuous
    Range("E29:K33").Borders(xlEdgeLeft).Weight = xlMedium
    Range("E29:K33").Borders(xlEdgeRight).LineStyle = xlContinuous
    Range("E29:K33").Borders(xlEdgeRight).Weight = xlMedium
    Range("E29:K33").Borders(xlEdgeBottom).LineStyle = xlContinuous
    Range("E29:K33").Borders(xlEdgeBottom).Weight = xlMedium
    If Range("E29").Value = "" Then Range("E29").Value = ""
    
    Range("E36:K40").Merge
    Range("E36:K40").Borders(xlEdgeTop).LineStyle = xlContinuous
    Range("E36:K40").Borders(xlEdgeTop).Weight = xlMedium
    Range("E36:K40").Borders(xlEdgeLeft).LineStyle = xlContinuous
    Range("E36:K40").Borders(xlEdgeLeft).Weight = xlMedium
    Range("E36:K40").Borders(xlEdgeRight).LineStyle = xlContinuous
    Range("E36:K40").Borders(xlEdgeRight).Weight = xlMedium
    If Range("E36").Value = "" Then Range("E36").Value = ""
    
    Range("N22:N33").UnMerge
    Range("N22:N26").Merge
   
    Range("N22:N26").Merge
    Range("N22").Borders(xlEdgeTop).LineStyle = xlContinuous
    Range("N22").Borders(xlEdgeTop).Weight = xlThin
    Range("N26").Borders(xlEdgeBottom).LineStyle = xlContinuous
    Range("N26").Borders(xlEdgeBottom).Weight = xlThin
    Range("N27:N28").Interior.ColorIndex = xlNone
            
    Range("N29:N33").Merge
    Range("N29").Borders(xlEdgeTop).LineStyle = xlContinuous
    Range("N29").Borders(xlEdgeTop).Weight = xlThin
    Range("N33").Borders(xlEdgeBottom).LineStyle = xlContinuous
    Range("N33").Borders(xlEdgeBottom).Weight = xlThin
    Range("N34:N35").Interior.ColorIndex = xlNone
    
    Range("N36:N40").Merge
    Range("N36").Borders(xlEdgeTop).LineStyle = xlContinuous
    Range("N36").Borders(xlEdgeTop).Weight = xlThin
    Range("N40").Borders(xlEdgeBottom).LineStyle = xlContinuous
    Range("N40").Borders(xlEdgeBottom).Weight = xlThin
    Range("N36:N40").Borders(xlEdgeLeft).LineStyle = xlContinuous
    Range("N36:N40").Borders(xlEdgeLeft).Weight = xlThin
    Range("N36:N40").Borders(xlEdgeRight).LineStyle = xlContinuous
    Range("N36:N40").Borders(xlEdgeRight).Weight = xlThin
    Range("N41:N42").Interior.ColorIndex = xlNone
    
    Range("M22:M40").UnMerge
    Range("M22:M26").Merge
    Range("M29:M33").Merge
    Range("M36:M40").Merge
    
    
    Range("M22").Borders(xlEdgeTop).LineStyle = xlContinuous
    Range("M22").Borders(xlEdgeTop).Weight = xlThin
    Range("M26").Borders(xlEdgeBottom).LineStyle = xlContinuous
    Range("M26").Borders(xlEdgeBottom).Weight = xlThin
       
    Range("M29").Borders(xlEdgeTop).LineStyle = xlContinuous
    Range("M29").Borders(xlEdgeTop).Weight = xlThin
    Range("M33").Borders(xlEdgeBottom).LineStyle = xlContinuous
    Range("M33").Borders(xlEdgeBottom).Weight = xlThin
       
    Range("M36").Borders(xlEdgeTop).LineStyle = xlContinuous
    Range("M36").Borders(xlEdgeTop).Weight = xlThin
    Range("M40").Borders(xlEdgeBottom).LineStyle = xlContinuous
    Range("M40").Borders(xlEdgeBottom).Weight = xlThin
    
    ' Insert bullet symbol in the range W23:X24 in Excel
    Range("W23:X24").Value = ChrW(&H2022)
    ' Remove bullet symbol from the ranges AA30 in Excel
    Range("AA30").Value = ""
    ' Remove bullet symbol from the ranges AA30 in Excel
    Range("AE37").Value = ""
    
    Range("AA30:AB31").UnMerge
    Range("AB37:AC38").UnMerge
    Range("AE37:AF38").UnMerge
    
    ' Add extra bold inside lines to the range AE37:AF38 in Excel
    Dim targetRange As Range
    Set targetRange = Union(Range("AA30:AB31"), Range("AE37:AF38"))
    
    ' Add extra bold inside vertical line
    With targetRange.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThick ' Adjust the thickness as needed
    End With
    
    ' Add extra bold inside horizontal line
    With targetRange.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThick ' Adjust the thickness as needed
    End With
    
     ' Set targetRange for the second range (T31:U34)
    Set targetRange2 = Range(("T31:U34"), ("T24:U27"))
    
    ' Remove the vertical line from the second range
    With targetRange2.Borders(xlInsideVertical)
        .LineStyle = xlNone
    End With
       
    ' Check if cell N22 is blank
If Range("N22").Value = "" Then
    ' If N22 is blank, set default value to "15 AMP"
    Range("N22").Value = "15 AMP"
End If
    ' Check if cell N29 is blank
If Range("N29").Value = "" Then
    ' If N29 is blank, set default value to "15 AMP"
    Range("N29").Value = "15 AMP"
End If
    ' Check if cell N36 is blank
If Range("N36").Value = "" Then
    ' If N36 is blank, set default value to "15 AMP"
    Range("N36").Value = "15 AMP"
End If

    ' Restore data validation for cells D29 & D36
    With Range("D29,D36").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
            Operator:=xlBetween, Formula1:="1,2,3"
        .IgnoreBlank = True
        .InCellDropdown = True
        .ShowInput = True
        .ShowError = True
    End With
 
    
    ' Restore data validation for cell N29 & N36
    With Range("N29,N36").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
            Operator:=xlBetween, Formula1:="15 AMP,20 AMP,25 AMP,30 AMP,40 AMP,45 AMP,50 AMP,60 AMP,70 AMP,80 AMP,90 AMP,100 AMP,110 AMP,125 AMP,150 AMP,175 AMP,200 AMP,225 AMP,250 AMP,300 AMP,350 AMP,400 AMP,N/A"
        .IgnoreBlank = True
        .InCellDropdown = True
        .ShowInput = True
        .ShowError = True
    End With
    
    ' Ensure Target is properly declared
Dim Target As Range
Set Target = Range("$D$22")



End Sub


Private Sub HandleCase2()

    ' Merges and unmerges cells based on Case2 being selected
    
    Range("C22:C33").Merge
    Range("C36:C40").Merge
    Range("C36").Value = "-"
    Range("C22:C33").Borders(xlEdgeBottom).LineStyle = xlContinuous
    Range("C22:C33").Borders(xlEdgeBottom).Weight = xlMedium
    Range("C22:C33").Borders(xlEdgeLeft).LineStyle = xlContinuous
    Range("C22:C33").Borders(xlEdgeLeft).Weight = xlMedium
    Range("C22:C33").Borders(xlEdgeRight).LineStyle = xlContinuous
    Range("C22:C33").Borders(xlEdgeRight).Weight = xlMedium
    Range("C34:C35").Borders(xlEdgeLeft).LineStyle = xlNone
    Range("C36:C40").Borders(xlEdgeTop).LineStyle = xlContinuous
    Range("C36:C40").Borders(xlEdgeTop).Weight = xlMedium
    Range("C36:C40").Borders(xlEdgeLeft).LineStyle = xlContinuous
    Range("C36:C40").Borders(xlEdgeLeft).Weight = xlMedium
    Range("C36:C40").Borders(xlEdgeRight).LineStyle = xlContinuous
    Range("C36:C40").Borders(xlEdgeRight).Weight = xlMedium
    
    Range("D22:D33").Merge
    Range("D34").UnMerge
    Range("D36:D40").UnMerge
    
    Range("D22:D33").Merge
    Range("D22:D33").Borders(xlEdgeBottom).LineStyle = xlContinuous
    Range("D22:D33").Borders(xlEdgeBottom).Weight = xlMedium
    Range("D22:D33").Borders(xlEdgeLeft).LineStyle = xlContinuous
    Range("D22:D33").Borders(xlEdgeLeft).Weight = xlMedium
    Range("D22:D33").Borders(xlEdgeRight).LineStyle = xlContinuous
    Range("D22:D33").Borders(xlEdgeRight).Weight = xlMedium
    Range("D34:D35").Interior.ColorIndex = xlNone
    
    Range("D36:D40").Merge
    Range("D36:D40").Borders(xlEdgeTop).LineStyle = xlContinuous
    Range("D36:D40").Borders(xlEdgeTop).Weight = xlMedium
    Range("D36:D40").Borders(xlEdgeLeft).LineStyle = xlContinuous
    Range("D36:D40").Borders(xlEdgeLeft).Weight = xlMedium
    Range("D36:D40").Borders(xlEdgeRight).LineStyle = xlContinuous
    Range("D36:D40").Borders(xlEdgeRight).Weight = xlMedium
    If Range("D36").Value = "" Then Range("D36").Value = 1
    
    Range("E22:K33").Merge
    Range("E22:K40").UnMerge
    
    Range("E22:K33").Merge
    Range("E22:K33").Borders(xlEdgeBottom).LineStyle = xlContinuous
    Range("E22:K33").Borders(xlEdgeBottom).Weight = xlMedium
    Range("E22:K33").Borders(xlEdgeLeft).LineStyle = xlContinuous
    Range("E22:K33").Borders(xlEdgeLeft).Weight = xlMedium
    Range("E22:K33").Borders(xlEdgeRight).LineStyle = xlContinuous
    Range("E22:K33").Borders(xlEdgeRight).Weight = xlMedium
    Range("E36:K40").Merge
    Range("E36:K40").Borders(xlEdgeTop).LineStyle = xlContinuous
    Range("E36:K40").Borders(xlEdgeTop).Weight = xlMedium
    Range("E36:K40").Borders(xlEdgeLeft).LineStyle = xlContinuous
    Range("E36:K40").Borders(xlEdgeLeft).Weight = xlMedium
    Range("E36:K40").Borders(xlEdgeRight).LineStyle = xlContinuous
    Range("E36:K40").Borders(xlEdgeRight).Weight = xlMedium
    If Range("E36").Value = "" Then Range("E36").Value = ""
    
           
    Range("M22:M26").Merge
    Range("M36:M40").UnMerge
        
    Range("M22:M26").Merge
    Range("M27:M28").Interior.ColorIndex = xlNone
    Range("M22:M26").Borders(xlEdgeBottom).LineStyle = xlContinuous
    Range("M22:M26").Borders(xlEdgeBottom).Weight = xlThin
    Range("M22:M26").Borders(xlEdgeLeft).LineStyle = xlContinuous
    Range("M22:M26").Borders(xlEdgeLeft).Weight = xlThick
    Range("M22:M26").Borders(xlEdgeRight).LineStyle = xlContinuous
    Range("M22:M26").Borders(xlEdgeRight).Weight = xlThin
    
    Range("M29:M33").Merge
    Range("M36:M40").UnMerge
    
    Range("M29:M33").Merge
    Range("M34:M35").Interior.ColorIndex = xlNone
    Range("M29:M33").Borders(xlEdgeBottom).LineStyle = xlContinuous
    Range("M29:M33").Borders(xlEdgeBottom).Weight = xlThin
    Range("M29:M33").Borders(xlEdgeLeft).LineStyle = xlContinuous
    Range("M29:M33").Borders(xlEdgeLeft).Weight = xlThick
    Range("M29:M33").Borders(xlEdgeRight).LineStyle = xlContinuous
    Range("M29:M33").Borders(xlEdgeRight).Weight = xlThin
    
    Range("M36:M40").Merge
    Range("M36").Borders(xlEdgeTop).LineStyle = xlContinuous
    Range("M36").Borders(xlEdgeTop).Weight = xlThin
    Range("M40").Borders(xlEdgeBottom).LineStyle = xlContinuous
    Range("M40").Borders(xlEdgeBottom).Weight = xlThin
    Range("M36:M40").Borders(xlEdgeLeft).LineStyle = xlContinuous
    Range("M36:M40").Borders(xlEdgeLeft).Weight = xlThick
    Range("M36:M40").Borders(xlEdgeRight).LineStyle = xlContinuous
    Range("M36:M40").Borders(xlEdgeRight).Weight = xlThin
    Range("M41:M42").Interior.ColorIndex = xlNone
        
    Range("N22:N33").Merge
    Range("N36:N40").UnMerge
    
    Range("N22:N33").Merge
    Range("N34:N35").Interior.ColorIndex = xlNone
    Range("N22:N33").Borders(xlEdgeBottom).LineStyle = xlContinuous
    Range("N22:N33").Borders(xlEdgeBottom).Weight = xlThin
    Range("N22:N33").Borders(xlEdgeLeft).LineStyle = xlContinuous
    Range("N22:N33").Borders(xlEdgeLeft).Weight = xlThin
    Range("N22:N33").Borders(xlEdgeRight).LineStyle = xlContinuous
    Range("N22:N33").Borders(xlEdgeRight).Weight = xlThin
    
    Range("N36:N40").Merge
    Range("N36").Borders(xlEdgeTop).LineStyle = xlContinuous
    Range("N36").Borders(xlEdgeTop).Weight = xlThin
    Range("N40").Borders(xlEdgeBottom).LineStyle = xlContinuous
    Range("N40").Borders(xlEdgeBottom).Weight = xlThin
    Range("N36:N40").Borders(xlEdgeLeft).LineStyle = xlContinuous
    Range("N36:N40").Borders(xlEdgeLeft).Weight = xlThin
    Range("N36:N40").Borders(xlEdgeRight).LineStyle = xlContinuous
    Range("N36:N40").Borders(xlEdgeRight).Weight = xlThin
    Range("N41:N42").Interior.ColorIndex = xlNone
    
    
   
    
    
    
    ' Insert bullet symbol in the ranges W23:X24 and AA30 in Excel
    Range("W23:X24, AA30").Value = ChrW(&H2022)
    ' Remove bullet symbol from the ranges AA30 in Excel
    Range("AE37").Value = ""
    
    Range("AA30:AB31").Merge
    Range("AE37:AF38").UnMerge
    
    ' Add extra bold inside lines to the range AE37:AF38 in Excel
    Dim targetRange As Range
    Set targetRange = Range("AE37:AF38")
    
    ' Add extra bold inside vertical line
    With targetRange.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThick ' Adjust the thickness as needed
    End With
    
    ' Add extra bold inside horizontal line
    With targetRange.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThick ' Adjust the thickness as needed
    End With
    
   ' Remove all borders for the specified ranges
    Range("AA30:AB31").Borders.LineStyle = xlNone
    
    
    
    ' Add extra bold inside lines to the range T24:U27 in Excel
    
    Set targetRange = Range("T24:U27")
    ' Add extra bold inside vertical line
    With targetRange.Borders(xlInsideVertical)
        .LineStyle = xlDash
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium ' Adjust the thickness as needed
    End With
    
    ' Set targetRange for the second range (T31:U34)
    Set targetRange2 = Range("T31:U34")
    
    ' Remove the vertical line from the second range
    With targetRange2.Borders(xlInsideVertical)
        .LineStyle = xlNone
    End With
    

    
    
    
    
    ' Check if cell N36 is blank
If Range("N36").Value = "" Then
    ' If N36 is blank, set default value to "15 AMP"
    Range("N36").Value = "15 AMP"
End If
    
    ' Restore data validation for cells D36
    With Range("D36").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
            Operator:=xlBetween, Formula1:="1,2,3"
        .IgnoreBlank = True
        .InCellDropdown = True
        .ShowInput = True
        .ShowError = True
    End With
    
    ' Restore data validation for cell N29
    With Range("N36").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
            Operator:=xlBetween, Formula1:="15 AMP,20 AMP,25 AMP,30 AMP,40 AMP,45 AMP,50 AMP,60 AMP,70 AMP,80 AMP,90 AMP,100 AMP,110 AMP,125 AMP,150 AMP,175 AMP,200 AMP,225 AMP,250 AMP,300 AMP,350 AMP,400 AMP,N/A"
        .IgnoreBlank = True
        .InCellDropdown = True
        .ShowInput = True
        .ShowError = True
    End With
    
    
     ' Ensure Target is properly declared
    Dim Target As Range
    Set Target = Range("$D$22")

   


End Sub

Private Sub HandleCase3()

' Merges and unmerges cells based on Case3 being selected
    
    Range("C22:C40").Merge
    Range("D22:D40").Merge
    Range("E22:K33").UnMerge
    Range("E22:K40").Merge
    
    
    Range("C22:C40").Borders(xlEdgeLeft).LineStyle = xlContinuous
    Range("C22:C40").Borders(xlEdgeLeft).Weight = xlMedium
    
    Range("C22:C40").Borders(xlEdgeRight).LineStyle = xlContinuous
    Range("C22:C40").Borders(xlEdgeRight).Weight = xlMedium
    
    Range("E22:K40").Borders(xlEdgeLeft).LineStyle = xlContinuous
    Range("E22:K40").Borders(xlEdgeLeft).Weight = xlMedium
    
    Range("K22:K40").Borders(xlEdgeRight).LineStyle = xlContinuous
    Range("K22:K40").Borders(xlEdgeRight).Weight = xlMedium
    
    Range("M22:M40").UnMerge
    Range("M22:M26").Merge
    Range("M29:M33").Merge
    Range("M36:M40").Merge
    
    Range("M27:M28").Interior.ColorIndex = xlNone
    Range("M26").Borders(xlEdgeBottom).LineStyle = xlContinuous
    Range("M26").Borders(xlEdgeBottom).Weight = xlThin
    Range("M22:M40").Borders(xlEdgeBottom).LineStyle = xlContinuous
    Range("M22:M40").Borders(xlEdgeLeft).LineStyle = xlContinuous
    Range("M22:M40").Borders(xlEdgeLeft).Weight = xlThick
    Range("M22:M40").Borders(xlEdgeRight).LineStyle = xlContinuous
    Range("M22:M40").Borders(xlEdgeRight).Weight = xlMedium
    Range("M29:M33").Merge
    Range("M29:M33").Borders(xlEdgeTop).LineStyle = xlContinuous
    Range("M29:M33").Borders(xlEdgeLeft).LineStyle = xlContinuous
    Range("M29:M33").Borders(xlEdgeLeft).Weight = xlThick
    Range("M29:M33").Borders(xlEdgeRight).LineStyle = xlContinuous
    Range("M29:M33").Borders(xlEdgeRight).Weight = xlThin
       
    Range("N22:N40").UnMerge
    Range("N22:N40").Merge
    Range("N27:N28").Interior.ColorIndex = xlNone
    Range("N22:N40").Borders(xlEdgeTop).LineStyle = xlContinuous
    Range("N22:N40").Borders(xlEdgeTop).Weight = xlThin
    Range("N22:N40").Borders(xlEdgeBottom).LineStyle = xlContinuous
    Range("N22:N40").Borders(xlEdgeBottom).Weight = xlThin
    Range("N22:N40").Borders(xlEdgeLeft).LineStyle = xlContinuous
    Range("N22:N40").Borders(xlEdgeLeft).Weight = xlThin
    Range("N22:N40").Borders(xlEdgeRight).LineStyle = xlContinuous
    Range("N22:N40").Borders(xlEdgeRight).Weight = xlThin
    
    
    ' Insert bullet symbol in the ranges W23:X24, AA30, and AE37 in Excel
    Range("W23:X24, AA30, AE37").Value = ChrW(&H2022)
    
    Range("AA30:AB31").Merge
    Range("AE37:AF38").Merge
    
    ' Remove all borders for the specified ranges
    Range("AE37:AF38").Borders.LineStyle = xlNone
    Range("AA30:AB31").Borders.LineStyle = xlNone


   
    ' Add dashed inside lines to the range T24:U27 and T31:U34 in Excel
    
    Dim targetRange As Range
    Set targetRange = Union(Range("T24:U27"), Range("T31:U34"))
    
    ' Add dashed inside vertical line
    With targetRange.Borders(xlInsideVertical)
        .LineStyle = xlDash
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium ' Adjust the thickness as needed
    End With
    

    

    
    
    ' Ensure Target is properly declared
    Dim Target As Range
    Set Target = Range("$D$22")
 

Attachments

  • 1710168783130.png
    1710168783130.png
    95.6 KB · Views: 6
Upvote 0
To have it trigger when the cell that is changed is D22, D29, D36, ..., D267, change this line in your code:
VBA Code: 
    If (Target.Address = "$D$22") And IsNumeric(Target.Value) Then
to this:
VBA Code: 
    If (Target.Column = 4) And IsNumeric(Target.Value) And (Target.Row >= 22) and (Target.Row <=267) and (Target.Row Mod 7 = 1) Then

Then, you can extract the row number that was updated like this:
VBA Code: 
Dim r as Long
r = Target.Row

Then you can change all your hard-code row references to dynamic calculations, i.e. this:
VBA Code: 
    Range("C22:C26").Merge
would change to this:
VBA Code: 
    Range("C" & r & ":C" & r + 4).Merge

I might use a range variable to make things a little easier to read, i.e.
I would change this section:
VBA Code: 
    Range("M22:M26").Merge
    Range("M27:M28").Interior.ColorIndex = xlNone
    Range("M22:M26").Borders(xlEdgeBottom).LineStyle = xlContinuous
    Range("M22:M26").Borders(xlEdgeBottom).Weight = xlThin
    Range("M22:M26").Borders(xlEdgeLeft).LineStyle = xlContinuous
    Range("M22:M26").Borders(xlEdgeLeft).Weight = xlThick
    Range("M22:M26").Borders(xlEdgeRight).LineStyle = xlContinuous
    Range("M22:M26").Borders(xlEdgeRight).Weight = xlThin

to something like this:
VBA Code: 
Dim rng as Range
Set rng = Range("M" & r & ":M" & r + 4)
With rng
    .Merge
    .Borders(xlEdgeBottom).LineStyle = xlContinuous
    .Borders(xlEdgeBottom).Weight = xlThin
    .Borders(xlEdgeLeft).LineStyle = xlContinuous
    .Borders(xlEdgeLeft).Weight = xlThick
    .Borders(xlEdgeRight).LineStyle = xlContinuous
    .Borders(xlEdgeRight).Weight = xlThin
End With
Range("M" & r + 5 & ":M" & r + 6).Interior.ColorIndex = xlNone

You would just need to apply these concepts to the rest of your code.
 
Upvote 0
I may need some direction on this. I'll see what I can do on my own. I dove into this spreadsheet knowing very little about VBA and I have learned SOOO much and it has been awesome to learn more. Again, I really appreciate your help on this. You have no idea how much you have helped already.
 
Upvote 0
Joek88 said:
I may need some direction on this. I'll see what I can do on my own. I dove into this spreadsheet knowing very little about VBA and I have learned SOOO much and it has been awesome to learn more. Again, I really appreciate your help on this. You have no idea how much you have helped already.
Click to expand...
I tried to spell out all the different pieces you need in detail. Now it should just be a matter of applying those concepts to your current code.
If you are going to be supporting VBA, this will be a good exercise to help familiarize yourself with VBA.

If you have a specific question/clarification on some aspect of what I posted, please feel free to post it here.
 
Upvote 0
Ok so for the first section. I tested this and it is exactly on the right track.

So I added what you placed in the chat to the existing code.

VBA Code: 
Private Sub sub4(ByVal Target As Range)
    If (Target.Column = 4) And IsNumeric(Target.Value) And (Target.Row >= 22) And (Target.Row <= 267) And (Target.Row Mod 7 = 1) Then
        Application.DisplayAlerts = False

        ' Unmerge cells before handling each case
        Range("C22:C40").UnMerge
        Range("D22:D40").UnMerge
        Range("C27:C28").Interior.ColorIndex = xlNone
        Range("C34:C35").Interior.ColorIndex = xlNone

        Select Case Target.Value
            Case 1
                HandleCase1
            Case 2
                HandleCase2
            Case 3
                HandleCase3
                
        End Select

        Application.DisplayAlerts = True
    End If
End Sub

This would have to change also correct? I would need this code to work for each associated cell that is being merged and changed back. How would this be changed to accommodate the rest of the cells and not just D22?
VBA Code: 
 ' Unmerge cells before handling each case
        Range("C22:C40").UnMerge
        Range("D22:D40").UnMerge
        Range("C27:C28").Interior.ColorIndex = xlNone
        Range("C34:C35").Interior.ColorIndex = xlNone

Sorry, we may have to go slow but it is helping me tremendously to be a better VBA code writer.
 
Upvote 0
You need to change EVERY single row reference in your code, like I showed you earlier today.
You get the current row number from the Target range, as I showed. Then you add the number of rows you need to offset that range by.

For example, when D22 was updated, we wanted run a line of code that did this:
VBA Code: 
   Range("M27:M28").Interior.ColorIndex = xlNone
What is the relationship of this range to the updated range?
Cell D22 gets updated, and we want to update M27 and M28.
If Cell D29 gets updated, we would want to update D34 and D35, right?

So what is the relationship?
Row 27 is 5 more then row 22 and row 28 is 6 more than row 22.
Likewise, 34 is 5 more then row 29 and row 35 is 6 more than row 29.
So, our "offset" from the updated row here is 5 and 6.

That is why we rewrote this line of code:
VBA Code: 
   Range("M27:M28").Interior.ColorIndex = xlNone
to this:
VBA Code: 
Range("M" & r + 5 & ":M" & r + 6).Interior.ColorIndex = xlNone

Make sense?
You have to apply this type of logic to ALL your row references.
 
Upvote 0
Ya I believe it is starting to make a little sense. So far, is this correct for the very first part of the sub4 code? For some reason, I don't think this is right.

VBA Code: 
Private Sub sub4(ByVal Target As Range)
    If (Target.Column = 4) And IsNumeric(Target.Value) And (Target.Row >= 22) And (Target.Row <= 267) And (Target.Row Mod 7 = 1) Then
        Application.DisplayAlerts = False

        ' Unmerge cells before handling each case
        Range("C22:C40").UnMerge
        Range("D22:D40").UnMerge
        Range("C27:C28").Interior.ColorIndex = xlNone
        Range("C34:C35").Interior.ColorIndex = xlNone

        Select Case Target.Value
            Case 1
                HandleCase1
            Case 2
                HandleCase2
            Case 3
                HandleCase3
                
        End Select

        Application.DisplayAlerts = True
    End If
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Question Question
VBA Program not working to merge cells
Replies
1
Views
437
Joe4
Joe4
R
  • Question Question
VBA - AUTO FIT, Can we remove make the sum formula in below code
Replies
1
Views
151
Joe4
Joe4
K
  • Question Question
VBA DOUBT- can we add heading color and remove blank columns in this code?
Replies
0
Views
156
Kishore1982
K
togenmoser
  • Solved
Help with VBA code error "For variable already in use"
2 3
Replies
22
Views
1K
MARK858
MARK858
J
  • Question Question
Applying VBA to other cells
Replies
2
Views
456
NoSparks
N

Forum statistics

Threads
1,223,227
Messages
6,170,849
Members
452,361
Latest member
d3ad3y3

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