How and where to save my VBA code to use in all my excel files

[jurcek24]

Hi, I have the code for a macro but i need to send it to a few people and they want to use it in more files. Is there a way they could it just save it in the Excel programm files and the macro would just work in all excel files they open. I'm very new to this so if you can describe it step by step or a link how it's done. Thanks to everyone

 

[My Aswer Is This]

Try the script I just provided and if it works for you I will explain where to install it so it will work on all sheets.

 

[jurcek24]

oh i completly forgot i could do it with cases. wait, what do i need to add for this code to work becouse it checks that the second column IS empty. the other are checking that if the first column is empty.

Dim x As Long
For x = 1 To 1000
If Cells(x, 1).Value = 5 And IsEmpty(Cells(x, 2).Value) Then
Cells(x, 1).Font.Color = vbBlack
Cells(x, 3).Font.Color = vbBlack
Cells(x, 3).Font.Bold = True
End If
Next x

Thank you

 

[My Aswer Is This]

Try this:
Not sure why you need if column 1 is not empty if its empty it would not fine a number value.
But here it is now with that part also.

Sub My_Script()
'Modified  2/13/2020  8:57:16 AM  EST
Application.ScreenUpdating = False
Dim i As Long
Dim Lastrow As Long
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Columns(1).Font.Color = vbBlack
Columns(9).EntireColumn.Delete
For i = 1 To Lastrow
Select Case Cells(i, 1).Value
    Case "8", Not IsEmpty(Cells(i, 1))
        Cells(i, 3).Font.Color = vbRed
        Cells(i, 1).Font.Color = vbRed
        Cells(i, 8).Font.Color = vbWhite
        Cells(i, 8).Interior.Color = vbRed
        Cells(i, 1).Font.Bold = True
        Cells(i, 3).Font.Bold = True
        
        Case "9", Not IsEmpty(Cells(i, 1))
            Cells(i, 1).Font.Color = vbGreen
            Cells(i, 3).Font.Color = vbBlack
            Cells(i, 8).Font.Color = vbBlack
            Cells(i, 3).Interior.Color = vbGreen
            Cells(i, 8).Interior.Color = vbGreen
            Cells(i, 1).Font.Bold = True
            Cells(i, 3).Font.Bold = True
            Cells(i, 8).Font.Bold = True
            
            Case "7", Not IsEmpty(Cells(i, 1))
                Cells(i, 1).Font.Color = RGB(51, 204, 51)
                Cells(i, 3).Font.Color = RGB(51, 204, 51)
                Cells(i, 8).Font.Color = RGB(51, 204, 51)
                Cells(i, 1).Font.Bold = True
                Cells(i, 3).Font.Bold = True
            Case "6", Not IsEmpty(Cells(i, 1))
                Cells(i, 1).Font.Color = RGB(47, 117, 181)
                Cells(i, 3).Font.Color = RGB(47, 117, 181)
                Cells(i, 8).Font.Color = RGB(47, 117, 181)
                Cells(i, 3).Font.Bold = True
                Cells(i, 8).Font.Bold = True
            Case "5", IsEmpty(Cells(i, 2))
                Cells(i, 1).Font.Color = vbBlack
                Cells(i, 3).Font.Color = vbBlack
                Cells(i, 3).Font.Bold = True
        End Select
Next
Application.ScreenUpdating = True
End Sub

 

[JackDanIce]

May be quicker to apply filters (fewer loop iterations, 5 in this instance instead of 1 to LR), which also eliminates need to test for empty cells in column A.

Below loops for values 5 - 9 in column A, after it filters column B for non-blank cells

Sub Main()
   
    Dim LR  As Long
    Dim x   As Long
    Dim r   As Range
   
    Application.ScreenUpdating = False
   
    With ActiveSheet
        If .AutoFilterMode Then .AutoFilterMode = False
        LR = .Cells(.Rows.Count, 1).End(xlUp).Row - 1
        With .Cells(1, 1).Resize(LR, 2)
            .Resize(, 1).Font.Color = vbBlack
            For x = 5 To 9
                .AutoFilter field:=2, Criteria1:="<>", field:=1, Criteria2:=x
                On Error Resume Next
                    Set r = .Cells(2, 1).Resize(LR).SpecialCells(xlCellTypeVisible)
                    If Not r Is Nothing Then Apply_Format r, x
                    Set r = Nothing
                On Error GoTo 0
            Next x
        End With
        .AutoFilterMode = False
        .Columns(9).Delete
        .Rows(1).Interior.Color = xlNone
        .Cells(1, 1).Select
    End With

    Application.ScreenUpdating = True

End Sub

Private Sub Apply_Format(ByRef r As Range, ByRef x As Long)
   
    Dim u   As Range

    With r
        Set u = Union(r, .Offset(, 2), .Offset(, 7))
        Select Case x
            Case 5
                .Offset(, 2).Font.Color = vbBlack
                .Offset(, 2).Font.Bold = True
            Case 6
                u.Font.Color = RGB(47, 117, 181)
                u.Font.Bold = True
                .Font.Bold = False
            Case 7
                u.Font.Color = RGB(51, 204, 51)
                u.Font.Bold = True
                .Offset(, 7).Font.Bold = False
            Case 8
                Set u = Union(r, .Offset(, 2))
                u.Font.Color = vbRed
                u.Font.Bold = True
                .Offset(, 7).Font.Color = vbWhite
                .Interior.Color = vbRed
            Case 9
                u.Font.Color = vbBlack
                u.Font.Bold = True
                u.Interior.Color = vbGreen
                .Font.Color = vbGreen
                .Interior.Color = xlNone
        End Select
    End With
   
    Set u = Nothing

End Sub

 

[jurcek24]

Thank you both for your help

 

[jurcek24]

i have one more thing i can't really find the anwser to. i have numbers starting from H2 and i need to add the € currency to them. do you maybe know the synatx or maybe the code to just add the € symbol at the end of the number ( now its 123,45, i need it to be 123,45€)

 

[JackDanIce]

You're welcome, hopefully you have a working solution.

Use cell formatting to format column H as: "#,##0.00 [$€-x-euro1]"