Question : Combine 2 excel macros into 1. that does both jobs in one shot.

Hi,

Combine 2 excel macros into 1. that does both jobs in one shot.
One code makes data caps in 3 sheets
And
Another makes colum P with different colors. Need all to run once as 1 code.

Regards
Sharath

Code Snippet:

         
           
             1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:

           
           
             Sub Make_All_Caps_Just_4_Colums_3_Sheets()
 
    Dim Rng1 As Range, rngArea As Range, i As Long, j As Long
    Dim X()
    Dim AppCalc As Long
    Dim avarSheets, varItem, avarCols, varCol
    Dim wks As Worksheet
    
    avarSheets = Array("Desktops", "DCS", "Stock")
    avarCols = Array("B", "F", "P", "AC")
    With Application
        AppCalc = .Calculation
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With
 
 
    
    For Each varItem In avarSheets
        Set wks = Sheets(varItem)
        For Each varCol In avarCols
           On Error Resume Next
           Set Rng1 = Intersect(wks.UsedRange, wks.Columns(varCol))
           On Error GoTo 0
    
           If Not Rng1 Is Nothing Then
               X = Rng1
               For i = 1 To UBound(X)
                   X(i, 1) = UCase$(X(i, 1))
               Next i
           End If
           Rng1 = X
       Next varCol
    Next varItem
 
    With Application
        .ScreenUpdating = True
        .Calculation = AppCalc
    End With
 
 
End Sub
 
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
Sub Color_Colum_P_Differentiate()
 
    Dim rng As Range, cell As Range
 
    Set rng = Range("P2:P" & Cells(65536, "E").End(xlUp).Row)
 
    For Each cell In rng
        If cell.Value <> "" Then
            Select Case Trim(UCase(cell.Value))
            Case Is = "DESKTOP"
                cell.Interior.ColorIndex = 36
            Case Is = "FREE SEAT"
                cell.Interior.ColorIndex = 35
            Case Is = "CDC LAPTOP"
                cell.Interior.ColorIndex = 31
            Case Is = "DCS"
                cell.Interior.ColorIndex = 40
            Case Is = "LAPTOP"
                cell.Interior.ColorIndex = 38
            Case Is = "NO IDEA"
                cell.Interior.ColorIndex = 39
            Case Is = "NO PC YET"
                cell.Interior.ColorIndex = 15
            Case Is = "PRINTER"
                cell.Interior.ColorIndex = 41
            Case Is = "TWIN USER"
                cell.Interior.ColorIndex = 42
            End Select
         End If
        Next cell
 
    End Sub

           
         

Open in New Window Select All

Answer : Combine 2 excel macros into 1. that does both jobs in one shot.

ummm....combining is easy, integrating them might be a little tricky, but if you want them to run as one, you can do this....of course you could also just call them both?

Make_All_Caps_Just_4_Colums_3_Sheets

Color_Colum_P_Differentiate

HTH
Cal

                       
         
           
             1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:

           
           
             Sub CombineBoth()
 
    Dim Rng1 As Range, rngArea As Range, i As Long, j As Long
    Dim X()
    Dim AppCalc As Long
    Dim avarSheets, varItem, avarCols, varCol
    Dim wks As Worksheet
    
    avarSheets = Array("Desktops", "DCS", "Stock")
    avarCols = Array("B", "F", "P", "AC")
    With Application
        AppCalc = .Calculation
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With
 
 
    
    For Each varItem In avarSheets
        Set wks = Sheets(varItem)
        For Each varCol In avarCols
           On Error Resume Next
           Set Rng1 = Intersect(wks.UsedRange, wks.Columns(varCol))
           On Error GoTo 0
    
           If Not Rng1 Is Nothing Then
               X = Rng1
               For i = 1 To UBound(X)
                   X(i, 1) = UCase$(X(i, 1))
               Next i
           End If
           Rng1 = X
       Next varCol
    Next varItem
 
    With Application
        .ScreenUpdating = True
        .Calculation = AppCalc
    End With
 
    Dim rng As Range, cell As Range
 
    Set rng = Range("P2:P" & Cells(65536, "E").End(xlUp).Row)
 
    For Each cell In rng
        If cell.Value <> "" Then
            Select Case Trim(UCase(cell.Value))
            Case Is = "DESKTOP"
                cell.Interior.ColorIndex = 36
            Case Is = "FREE SEAT"
                cell.Interior.ColorIndex = 35
            Case Is = "CDC LAPTOP"
                cell.Interior.ColorIndex = 31
            Case Is = "DCS"
                cell.Interior.ColorIndex = 40
            Case Is = "LAPTOP"
                cell.Interior.ColorIndex = 38
            Case Is = "NO IDEA"
                cell.Interior.ColorIndex = 39
            Case Is = "NO PC YET"
                cell.Interior.ColorIndex = 15
            Case Is = "PRINTER"
                cell.Interior.ColorIndex = 41
            Case Is = "TWIN USER"
                cell.Interior.ColorIndex = 42
            End Select
         End If
        Next cell
 
    End Sub
 
 
Open in New Window Select All 

           
         

Open in New Window Select All