Posts by ajoy123rocks

ajoy123rocks · Mar 2nd 2022

Now the sheet is split into two pages.

I need the sheet to fit into one page both width and height wise and need the full page width.

ajoy123rocks · Mar 2nd 2022

PFA output pdfs... in one the page width is proper as per the code, while in the other the righ margin has increased. I need the excel to fit the entire page width.

Code

   With ActiveSheet.PageSetup

        .CenterVertically = True
        .Orientation = xlLandscape
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1

        .LeftMargin = Application.InchesToPoints(0.5)
        .RightMargin = Application.InchesToPoints(0.75)
        .TopMargin = Application.InchesToPoints(1.5)
        .BottomMargin = Application.InchesToPoints(1)
    End With

Display More

ajoy123rocks · Feb 7th 2022

Thanks Roy... issue resolved.

ajoy123rocks · Feb 7th 2022

If create a new sheet in a workbook via macro, is there a way to automatically also include a code for worksheet_change event on that sheet.?

I am creating sheet with name "Group A" in a workbook via macro.

There a cells that have to change to uppercase once the user enters values into it.

How can i achieve this?

ajoy123rocks · Nov 19th 2021

The two shapes encircled in red in the attached screenshot (dss_1) display two difference top values when ActiveWindow.Zoom = 110. As a result the blue lines are not getting added at the proper place in the left shape. The same works properly when ActiveWindow.Zoom = 100 (screenshot dss_2)

The co-ordinates when zoom = 110 are

(top, left height, width)

Left shape: 609 52 15 24

Right shape: 602 77 14 24

The co-ordinates when zoom = 100 are

(top, left height, width)

Left shape: 602 53 14 24

Right shape:602 77 14 24

kindly help

ajoy123rocks · Nov 11th 2021

Issue resolved

ajoy123rocks · Nov 11th 2021

Ok sir.. Thanks a lot for the timely help.

ajoy123rocks · Nov 11th 2021

i changed the part of code to the following and it worked

Code

            ActiveSheet.Unprotect Password:="1234"
            Target.Font.Color = vbRed
            ActiveSheet.Protect Password:="1234"
            Else
            
            ActiveSheet.Unprotect Password:="1234"
            Target.Font.Color = vbBlack
            ActiveSheet.Protect Password:="1234"

ajoy123rocks · Nov 11th 2021

Changing to ucase is working but when i enter any score in Col F , it gives error. Screenshot attached

ajoy123rocks · Nov 11th 2021

I just unlocked the sheet and tried to make changes in col A and Col F. The change event is not being triggered.

ajoy123rocks · Nov 11th 2021

When there are 4 teams only only F9 to F14 are user input fields when there are 6 teams F9 to F23 will become unlocked and user changeable. Do I have to make F9 to F333 unlocked each time irrespective of number of teams?

ajoy123rocks · Nov 11th 2021

Worksheet change sub is the only place i am using enableevents....

ajoy123rocks · Nov 11th 2021

But the same is not working on my machine. What could be the reason? any excel settings?

ajoy123rocks · Nov 11th 2021

Hmm.... If the user enters 20-0 or 0-20 in col F it should automatically change to red color and black otherwise. Also user entered field in A9 to A34 and B3 must change to uppercase once entered.

ajoy123rocks · Nov 11th 2021

But F9 to F333 is not. Those fields are the input by the user. Same with A9 to A34

ajoy123rocks · Nov 11th 2021

If i comment out the error handling section, it gives Run time error 1004... Application defined or object define error at line 31 in the above code.

ajoy123rocks · Nov 11th 2021

I believe i cannot use conditional formatting because the once i reset and generate again the cell contents including formatting are cleared and recreated.

ajoy123rocks · Nov 11th 2021

Code

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Left_score As Integer
Dim Right_score As Integer

Application.ScreenUpdating = False

If Target.Cells.count > 1 Or Target.HasFormula Then Exit Sub

    On Error Resume Next
    If Not Intersect(Target, Range("B3,A9:A34")) Is Nothing Then
        Application.EnableEvents = False
        
        Target = UCase(Target)
        Application.EnableEvents = True
    End If
    
    
    If Not Intersect(Target, Range("F9:F333")) Is Nothing Then
        Application.EnableEvents = False
        
         Left_score = Trim(Split(Target, "-")(0))
 
         Right_score = Trim(Split(Target, "-")(1))
    
        If (Left_score = 20 And Right_score = 0) Or (Left_score = 0 And Right_score = 20) Then

            MsgBox 1
            Target.Font.ColorIndex = 3

            Else
            MsgBox 2
            Target.Font.ColorIndex = 1
           
        End If
            
        Application.EnableEvents = True
    End If
    
    
    On Error GoTo 0

End Sub

Display More

I have changed the code but the problem persists. PFA the worksheet. Enter the number of teams and press Generate. Enter the scores in column F from F9 onwards.

Sample scores: 20-0, 44-55,66-77, 0-20 and so on. 20-0 and 0-20 must change to red and others to black.

ajoy123rocks · Nov 10th 2021

Code

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Left_score As Integer
Dim Right_score As Integer
'Dim cell As Range

Application.ScreenUpdating = False

    If Not (Application.Intersect(Target, Range("B3,A9:A34")) Is Nothing) Then
    On Error GoTo safe_exit
        With Target
            If Not .HasFormula Then
                Application.EnableEvents = False
                
                'MsgBox 3
                'If .Value <> "" Then
                                
                    .Value = UCase(.Value)
                'End If
                Application.EnableEvents = True
                
            End If
        End With
   End If
   
      If Not (Application.Intersect(Target, Range("F9:F333")) Is Nothing) Then
      On Error GoTo safe_exit
      'Application.EnableEvents = False
        With Target
            If Not .HasFormula Then
                Application.EnableEvents = False
                'Application.ScreenUpdating = False
                '.Value = UCase(.Value)
                
                         Left_score = Trim(Split(.Value, "-")(0))
                
                         Right_score = Trim(Split(.Value, "-")(1))
                         
                         'MsgBox Left_score
                         'MsgBox Right_score
                         
                          If (Left_score = 20 And Right_score = 0) Or (Left_score = 0 And Right_score = 20) Then
                          'MsgBox 1
                            'Application.EnableEvents = False
                                .Font.ColorIndex = 3
                             'Application.EnableEvents = True
                             'MsgBox 4
                         Else
                         'MsgBox 2
                         'Application.EnableEvents = False
                            .Font.ColorIndex = 1
                            'Application.EnableEvents = True
                         End If
                
                Application.EnableEvents = True
                'Application.ScreenUpdating = True
            End If
        End With
        'Application.EnableEvents = True
    End If

safe_exit:
       Application.EnableEvents = True
    'Application.ScreenUpdating = True
   


'Application.EnableEvents = True
End Sub

Display More

The first part of setting the range to Uppercase is working, but the second part of changing the font colour is not. The event is being triggered but the font color is not changing. The code runs till "Msgbox 1" but does not change the font color or display "Msgbox 4". Kindly help

Code

ajoy123rocks · Nov 9th 2021

Code

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Left_score As Integer
Dim Right_score As Integer
'Dim cell As Range

Application.ScreenUpdating = False

    If Not (Application.Intersect(Target, Range("B3,A9:A34")) Is Nothing) Then
    On Error GoTo safe_exit
        With Target
            If Not .HasFormula Then
                Application.EnableEvents = False
                
                'MsgBox 3
                'If .Value <> "" Then
                                
                    .Value = UCase(.Value)
                'End If
                Application.EnableEvents = True
                
            End If
        End With
   End If
   
      If Not (Application.Intersect(Target, Range("F9:F333")) Is Nothing) Then
      On Error GoTo safe_exit
        With Target
            If Not .HasFormula Then
                Application.EnableEvents = False


                
                         Left_score = Trim(Split(.Value, "-")(0))
                
                         Right_score = Trim(Split(.Value, "-")(1))
                         
                         'MsgBox Left_score
                         'MsgBox Right_score
                         
                          If (Left_score = 20 And Right_score = 0) Or (Left_score = 0 And Right_score = 20) Then
                                   .Font.ColorIndex = 3
                         
                        Else
                                     .Font.ColorIndex = 1
                         End If
                
                Application.EnableEvents = True

            End If
        End With
    End If

safe_exit:
       Application.EnableEvents = True

End Sub

Display More

The first part of code to change to Upper case is working whereas the second part of changing the color is not. Kindly help

Posts by ajoy123rocks

Page setup getting changed

Page setup getting changed

Include worksheet change event automatically

Include worksheet change event automatically

Shape co-ordinates discrepancy when zoom level set to 110

Worksheet change event not working

Worksheet change event not working

Worksheet change event not working

Worksheet change event not working

Worksheet change event not working

Worksheet change event not working

Worksheet change event not working

Worksheet change event not working

Worksheet change event not working

Worksheet change event not working

Worksheet change event not working

Worksheet change event not working

Worksheet change event not working

Worksheet change event not working

Re-opening .xlsm sheet post saving gives error