VBA Formatting Code Formatting Wrong Range of Cells

A

Ark68

Well-known Member
Joined
Mar 23, 2004
Messages
4,564
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
I am having an unusual problem with the VBA formating of some ranges in my workbook.

In my project, when the user presses a button from a home page (worksheet gui_s), it takes the user to a working worksheet ("SCHEDULE-Date"). This is done with a macro called "sched_date" This macro first and formost prepares the worksheet for presentation (putting it in a default mode), by clearing and reformatting ranges of cells, calculating and displaying default values, and creating cell validations.

Code: 
Sub sched_date()
    'Stop
    With ws_dsched
        mbevents = False
        .Activate
        .Unprotect
        
        'date user interface
        With .Range("D2:G2")
            .Value = ""
        End With
        With .Range("D2:F2")
            .Cells.Interior.Color = RGB(218, 238, 243)
        End With
        With .Range("G2")
            .Cells.Interior.ColorIndex = 0
        End With
        
        With .Range("J2")
            .Value = ""
            .Cells.Interior.ColorIndex = 0
        End With
        With .Range("M2")
            .Value = ""
            .Cells.Interior.ColorIndex = 0
        End With
        
        'processed card range
        With .Range("B6:B45")
            .UnMerge
            .Interior.ColorIndex = 0
            .Value = ""
            .HorizontalAlignment = xlCenter
            .Locked = True
            With .Borders(xlEdgeLeft)
                .LineStyle = xlContinuous
                .ThemeColor = 4
                .TintAndShade = -0.249946592608417
                .Weight = xlThin
            End With
            With .Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .ThemeColor = 4
                .TintAndShade = -0.249946592608417
                .Weight = xlThin
            End With
            With .Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .ThemeColor = 4
                .TintAndShade = -0.249946592608417
                .Weight = xlThin
            End With
            With .Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .ThemeColor = 4
                .TintAndShade = -0.249946592608417
                .Weight = xlThin
            End With
            With .Borders(xlInsideHorizontal)
                .LineStyle = xlContinuous
                .ThemeColor = 4
                .TintAndShade = -0.249946592608417
                .Weight = xlHairline
            End With
        End With
        
        'pre schedule date
        With .Range("H6:K45")
            .UnMerge
            .Interior.ColorIndex = 0
            .Value = ""
            .HorizontalAlignment = xlCenter
            .Locked = True
            With .Borders(xlEdgeLeft)
                .LineStyle = xlContinuous
                .ThemeColor = 4
                .TintAndShade = -0.249946592608417
                .Weight = xlThin
            End With
            With .Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .ThemeColor = 4
                .TintAndShade = -0.249946592608417
                .Weight = xlThin
            End With
            With .Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .ThemeColor = 4
                .TintAndShade = -0.249946592608417
                .Weight = xlThin
            End With
            With .Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .ThemeColor = 4
                .TintAndShade = -0.249946592608417
                .Weight = xlThin
            End With
            With .Borders(xlInsideVertical)
                .LineStyle = xlContinuous
                .ThemeColor = 4
                .TintAndShade = -0.249946592608417
                .Weight = xlThin
            End With
            With .Borders(xlInsideHorizontal)
                .LineStyle = xlContinuous
                .ThemeColor = 4
                .TintAndShade = -0.249946592608417
                .Weight = xlHairline
            End With
        End With
        
        'post schedule data
        With .Range("M6:Q45")
            .UnMerge
            .HorizontalAlignment = xlCenter
            .Value = ""
            .Cells.Interior.ColorIndex = 0
            .Locked = True
            With .Borders(xlEdgeLeft)
                .LineStyle = xlContinuous
                .ThemeColor = 4
                .TintAndShade = -0.249946592608417
                .Weight = xlThin
            End With
            With .Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .ThemeColor = 4
                .TintAndShade = -0.249946592608417
                .Weight = xlThin
            End With
            With .Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .ThemeColor = 4
                .TintAndShade = -0.249946592608417
                .Weight = xlThin
            End With
            With .Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .ThemeColor = 4
                .TintAndShade = -0.249946592608417
                .Weight = xlThin
            End With
            With .Borders(xlInsideVertical)
                .LineStyle = xlContinuous
                .ThemeColor = 4
                .TintAndShade = -0.249946592608417
                .Weight = xlThin
            End With
            With .Borders(xlInsideHorizontal)
                .LineStyle = xlContinuous
                .ThemeColor = 4
                .TintAndShade = -0.249946592608417
                .Weight = xlHairline
            End With
        End With
        
        'obscure post schedule data
        .Shapes("date_shade").Visible = True

        'determine today's date to autopopulate user query date fields
        today1
        'determine tomorrow's date to autopopulate user query date fields
        tomorrow1
        'determine yesterday's date to autopopulate user query date fields
        yesterday1
        'leap year
        Leap_Year
        'determine numberof days inb the month
        Month_Validation
        
        'display
        .Unprotect
        'mbevents = False
        On Error Resume Next
        ActiveWorkbook.Names("nr_yrsel").Delete 'deletes year range for validation list
        cyr = Year(Date)
        rw_cyr = Application.WorksheetFunction.Match(cyr, ws_lists.Range("A1:A32"), 0)
        ws_lists.Range("A" & (rw_cyr - 1) & ":A" & (rw_cyr + 1)).Name = "nr_yrsel"
        With .Range("D2").Validation
            .Delete 'delete pre-existing validation
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:="=nr_yrsel"
            .ErrorTitle = "INVALID DATE"
            .ErrorMessage = "An invalid date has been entered." & Chr(13) & "Please enter a permitted year (current year +/- one year)."
        End With
        With .Range("E2").Validation
            .Delete 'delete pre-existing validation
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:="=nr_mnsel"
            .ErrorTitle = "INVALID DATE"
            .ErrorMessage = "An invalid date has been entered." & Chr(13) & "Please enter or select a textual month (MMM)."
        End With
        .Range("D2") = Format(Date, "yyyy")
        .Range("E2") = UCase(Format(Date, "mmm"))
        .Range("F2") = Format(Date, "dd")
        .Range("G2") = UCase(Format(Date, "ddd"))
        .Range("D2").Locked = False
        With .Range("J2")
            .Value = Format(yesterday, "DDD MMM DD YYYY")
            .Locked = True
        End With
        With .Range("M2")
            .Value = Format(tomorrow, "DDD MMM DD YYYY")
            .Locked = True
        End With
    
        'Buttons
         With .Shapes("sh1u")
             .Fill.ForeColor.RGB = RGB(91, 155, 213) 'blue
             .Visible = True
             .OnAction = "GUI_S_Reset1"
         End With
         With .Shapes("sh2_submit")
             .Fill.ForeColor.RGB = RGB(169, 209, 142) 'green
             .Visible = True
             .OnAction = "GUI_S_Submit1"
         End With
         .Protect
    End With
    
    mbevents = True
End Sub

This macro properly formats the table and data as expected and is ready to be populated on the user's actions. Their are three ranges which make up the table: B6:B45 ("processed card range"), H6:K45 ("post schedule data" and M6:Q45 ("post schedule data").

Once prepared the user can select a date to query using the 3 dropdown lists in the validated cells of D2:F2. If the user is ok with tyhe selected date, pressing submit will populate the chart created.
The reset button (assigned macro GUI_Reset) when pressed is intended to return that worksheet to it'd default state by once again clearing and reformatting ranges of cells, calculating and displaying default values, and creating cell validations.

Rich (BB code): 
Sub GUI_S_Reset1()
    'Stop
    mbevents = False
    declaration
    With ws_dsched
        .Unprotect
        .Shapes("sh1u").Visible = True
        .Shapes("sh2_submit").Visible = True
        
        today1
        tomorrow1
        yesterday1
        Leap_Year
        Month_Validation
        
        .Unprotect
        .Range("D2") = Format(Date, "yyyy")
        .Range("E2") = UCase(Format(Date, "mmm"))
        .Range("F2") = Format(Date, "dd")
        .Range("G2") = UCase(Format(Date, "ddd"))
        Stop

        'pre schedule data
       'This appears to be functioning as expected.
        With .Range("H6:K45")
            .UnMerge
            .Interior.ColorIndex = 0
            .Value = ""
            .HorizontalAlignment = xlCenter
            .Locked = True
            With .Borders(xlEdgeLeft)
                .LineStyle = xlContinuous
                .ThemeColor = 4
                .TintAndShade = -0.249946592608417
                .Weight = xlThin
            End With
            With .Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .ThemeColor = 4
                .TintAndShade = -0.249946592608417
                .Weight = xlThin
            End With
            With .Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .ThemeColor = 4
                .TintAndShade = -0.249946592608417
                .Weight = xlThin
            End With
            With .Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .ThemeColor = 4
                .TintAndShade = -0.249946592608417
                .Weight = xlThin
            End With
            With .Borders(xlInsideVertical)
                .LineStyle = xlContinuous
                .ThemeColor = 4
                .TintAndShade = -0.249946592608417
                .Weight = xlThin
            End With
            With .Borders(xlInsideHorizontal)
                .LineStyle = xlContinuous
                .ThemeColor = 4
                .TintAndShade = -0.249946592608417
                .Weight = xlHairline
            End With
            
            'post schedule data
            'Problems! range needing reformatting is M6:Q45, however range T11:X50 is receiving the formatting???
            With .Range("M6:Q45")
                .UnMerge
                .HorizontalAlignment = xlCenter
                .Value = ""
                .Cells.Interior.ColorIndex = 0
                .Locked = True
                With .Borders(xlEdgeLeft)
                    .LineStyle = xlContinuous
                    .ThemeColor = 4
                    .TintAndShade = -0.249946592608417
                    .Weight = xlThin
                End With
                With .Borders(xlEdgeTop)
                    .LineStyle = xlContinuous
                    .ThemeColor = 4
                    .TintAndShade = -0.249946592608417
                    .Weight = xlThin
                End With
                With .Borders(xlEdgeBottom)
                    .LineStyle = xlContinuous
                    .ThemeColor = 4
                    .TintAndShade = -0.249946592608417
                    .Weight = xlThin
                End With
                With .Borders(xlEdgeRight)
                    .LineStyle = xlContinuous
                    .ThemeColor = 4
                    .TintAndShade = -0.249946592608417
                    .Weight = xlThin
                End With
                With .Borders(xlInsideVertical)
                    .LineStyle = xlContinuous
                    .ThemeColor = 4
                    .TintAndShade = -0.249946592608417
                    .Weight = xlThin
                End With
                With .Borders(xlInsideHorizontal)
                    .LineStyle = xlContinuous
                    .ThemeColor = 4
                    .TintAndShade = -0.249946592608417
                    .Weight = xlHairline
                End With
            End With
            
            'processed card range
            'Problems! range needing reformatting is B6:B45, however range I11:I50 is receiving the formatting???
            With .Range("B6:B45")
                .UnMerge
                .Interior.ColorIndex = 0
                .Value = ""
                .HorizontalAlignment = xlCenter
                .Locked = True
                With .Borders(xlEdgeLeft)
                    .LineStyle = xlContinuous
                    .ThemeColor = 4
                    .TintAndShade = -0.249946592608417
                    .Weight = xlThin
                End With
                With .Borders(xlEdgeTop)
                    .LineStyle = xlContinuous
                    .ThemeColor = 4
                    .TintAndShade = -0.249946592608417
                    .Weight = xlThin
                End With
                With .Borders(xlEdgeBottom)
                    .LineStyle = xlContinuous
                    .ThemeColor = 4
                    .TintAndShade = -0.249946592608417
                    .Weight = xlThin
                End With
                With .Borders(xlEdgeRight)
                    .LineStyle = xlContinuous
                    .ThemeColor = 4
                    .TintAndShade = -0.249946592608417
                    .Weight = xlThin
                End With
                With .Borders(xlInsideHorizontal)
                    .LineStyle = xlContinuous
                    .ThemeColor = 4
                    .TintAndShade = -0.249946592608417
                    .Weight = xlHairline
                End With
            End With
        End With
        .Protect
    End With
    mbevents = True
End Sub

The issue I am encountering is that the reformatting of ranges M6:Q45 and B6:B45 is occuring in ranges T11:X50 and I11:I50 respectively, not in the ranges desired.
Another possibly unrelated issue occurs when I copy SCHEDULE-Date Range B6:Q45 and paste to worksheet Backup cell A3. It's pasting three rows of data that do not appear in the copied source data, and omitting the last three rows of the copied data.

I am stumped and reaching out to the pros to help me over come this problem.

I have made my workbook accessible here.
To recreate (hopefully), launch the file, from the GUI_S worksheet, click on the blue "Sched Date button". Select an inquiry date of 2020 Jul 18 and press submit. Range H6:K45 should populate with data.
Press reset. There is stop code in the reset module, Step through and observe the results on worksheet "SCHEDULE-Date"
 

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.
Sort by date Sort by votes
You have stacked With statements that are causing the problem. The second and third statements for the ranges are cueing off of the previous range parameter.
Run this simple macro on a blank sheet to see what I mean.

Code: 
Sub t()
With Sheet1
With .Range("C1:F4")
    .Value = "x"
    With .Range("G2:J5")
        .Value = "Y"
    End With
End With
End With
End Sub

to fix it
Code: 
Sub t()
With Sheet1
    With .Range("C1:F4")
        .Value = "x"
    End With
    With .Range("G2:J5")
        .Value = "Y"
    End With
End With
End Sub
 
Upvote 0
Thank yoiu so much JLGWhiz! 40+ minutes to prepare my post for a 5 second repair.
But I would never have found that without a second set of eyes. It's working well now.
 
Upvote 0
You must log in or register to reply here.

Similar threads

L
  • Locked
  • Question
Help Cleaning Up Code
Replies
2
Views
320
RoryA
RoryA
K
  • Solved
formating question
Replies
3
Views
66
Micron
M
P
  • Question
Issue with button not running in spread sheet only in test mode
Replies
1
Views
181
6StringJazzer
6StringJazzer
togenmoser
  • Solved
Help with VBA code error "For variable already in use"
2 3
Replies
22
Views
307
MARK858
MARK858
K
  • Solved
create a button that do actions
2 3
Replies
22
Views
847
kerm007
K

Forum statistics

Threads
1,214,632
Messages
6,120,649
Members
448,975
Latest member
sweeberry

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