Could you guys help me combine these macros yet again?

[Coyotex3]

Trying to combine these 5 macros into one if possible

Sub Coyote10()
    Dim LR As Long, i As Long
    Application.ScreenUpdating = False
    LR = Range("A" & Rows.Count).End(xlUp).Row
    Range("I1").EntireColumn.Insert
    Range("I1") = "Address"
    For i = 2 To LR
        Range("I" & i) = Range("E" & i).Value2 & ", " & Range("F" & i).Value2 & ", " & _
                         Range("G" & i).Value2 & " " & Range("H" & i).Value2
    Next i
    Range("E1:H1").EntireColumn.Delete
    Application.ScreenUpdating = True
End Sub
Sub Coyote12A()
    Dim LR As Long, i As Long
    Application.ScreenUpdating = False
    LR = Range("A" & Rows.Count).End(xlUp).Row
    Range("N1").EntireColumn.Insert
    Range("N1") = "City"
    For i = 2 To LR
        Range("N" & i) = Range("J" & i).Value2 & ", " & Range("K" & i).Value2 & ", " & _
                         Range("L" & i).Value2 & " " & Range("M" & i).Value2
    Next i
    Range("J1:M1").EntireColumn.Delete
    Application.ScreenUpdating = True
End Sub
Sub Coyote13A()
    Dim LR As Long, i As Long
    Application.ScreenUpdating = False
    LR = Range("A" & Rows.Count).End(xlUp).Row
    Range("D1").EntireColumn.Insert
    Range("D1") = "Code"
    For i = 2 To LR
        Range("D" & i) = Range("C" & i).Value2 & 4
    Next i
    Application.ScreenUpdating = True
End Sub
Sub Coyote14A()
    Dim LR As Long, i As Long
    Application.ScreenUpdating = False
    LR = Range("A" & Rows.Count).End(xlUp).Row
    Range("E1").EntireColumn.Insert
    Range("E1") = "Alt Code"
    For i = 2 To LR
        Range("E" & i) = Range("C" & i).Value2 & 1
    Next i
    Application.ScreenUpdating = True
End Sub
Sub Coyote15A()
    Dim LR As Long, i As Long
    Application.ScreenUpdating = False
    LR = Range("A" & Rows.Count).End(xlUp).Row
    Range("F1").EntireColumn.Insert
    Range("F1") = "Extra Code"
    For i = 2 To LR
        Range("F" & i) = 201250
    Next i
    Application.ScreenUpdating = True
End Sub

 

[Coyotex3]

Ok I wrapped it up tonight. Tossed in the array approach in case you have a bunch of rows to handle.

Lemme know how it goes. Should be faster if you have a bunch of rows to go through.

Sub NewV4()
'
    Dim LR                      As Long, i                          As Long
    Dim Column_C_Array          As Variant, Column_E_Array          As Variant, Column_M_Array          As Variant
    Dim Columns_D_Thru_F_Array  As Variant, Columns_F_Thru_H_Array  As Variant, Columns_N_Thru_P_Array  As Variant
'
    Application.ScreenUpdating = False                                                                  ' Turn ScreenUpdating off
'
    LR = Range("A" & Rows.Count).End(xlUp).Row                                                          ' Find last row # of data to be used
'
    Column_C_Array = Range("C2:C" & LR)                                                                 ' Store Column C values into 2D, 1 Based array RC
    Column_E_Array = Range("E2:E" & LR)                                                                 ' Store Column E values into 2D, 1 Based array RC
    Column_M_Array = Range("M2:M" & LR)                                                                 ' Store Column E values into 2D, 1 Based array RC
    Columns_D_Thru_F_Array = Range("D2:F" & LR)                                                         ' Store Columns D:F values into 2D, 1 Based array RC
    Columns_F_Thru_H_Array = Range("F2:H" & LR)                                                         ' Store Columns F:H values into 2D, 1 Based array RC
    Columns_N_Thru_P_Array = Range("N2:P" & LR)                                                         ' Store Columns N:P: values into 2D, 1 Based array RC
'
'   Combine columns E:H into E, Delete F:H
    For i = 1 To UBound(Columns_F_Thru_H_Array)                                                         ' Loop through arrays to create column E results
        Column_E_Array(i, 1) = Column_E_Array(i, 1) & ", " & Columns_F_Thru_H_Array(i, 1) & ", " & _
                Columns_F_Thru_H_Array(i, 2) & ", " & Columns_F_Thru_H_Array(i, 3)
    Next                                                                                                ' Loop back
'
    Range("E2:E" & LR) = Column_E_Array                                                                 ' Display results of Column_E_Array to screen
    Range("F1:H1").EntireColumn.Delete                                                                  ' Delete Columns F:H
'
'
'   Combine Columns J:M into J, Delete K:M
    For i = 1 To UBound(Columns_N_Thru_P_Array)                                                         ' Loop through arrays to create column M results
        Column_M_Array(i, 1) = Column_M_Array(i, 1) & ", " & Columns_N_Thru_P_Array(i, 1) & ", " & _
                Columns_N_Thru_P_Array(i, 2) & ", " & Columns_N_Thru_P_Array(i, 3)
    Next                                                                                                ' Loop back
'
    Range("J2:J" & LR) = Column_M_Array                                                                 ' Display results of Column_M_Array to screen
    Range("K1:M1").EntireColumn.Delete                                                                  ' Delete Columns K:M
'
'
    Range("D1:F1").EntireColumn.Insert                                                                  ' Insert Columns D:F
    For i = 1 To UBound(Columns_D_Thru_F_Array)                                                         ' Loop through arrays to create column D:F results
        Columns_D_Thru_F_Array(i, 1) = Column_C_Array(i, 1) & 4
        Columns_D_Thru_F_Array(i, 2) = Column_C_Array(i, 1) & 1
        Columns_D_Thru_F_Array(i, 3) = 201250
    Next                                                                                                ' Loop back
'
    Range("D2:F" & LR) = Columns_D_Thru_F_Array                                                         ' Display results of Columns_D_Thru_F_Array to screen
'
'   Apply Headers to columnns
    Range("D1:F1").Value = Array("Code", "Alt Code", "Extra Code")
    Range("H1") = "Address"
    Range("M1") = "City"
'
'   Autofit columns
    Range("D1:F1").EntireColumn.AutoFit
    Range("H1").EntireColumn.AutoFit
    Range("M1").EntireColumn.AutoFit
'
    Application.ScreenUpdating = True                                                                   ' Turn ScreenUpdating back on
End Sub

@johnnyL thank you so much. I will give this one a shot now. I posted another thread enlisting help to speed up a macro. Would appreciate it if you took a look and told me what you thought.

 

[johnnyL]

What is the link to the thread?

 

[Coyotex3]

What is the link to the thread?

Is there a way of speeding up these codes? It takes about 2 minutes to run this code with 6k rows.

Sub OrderFormatting() Range("A1:P40000").Select With Selection .Hyperlinks.Delete With Selection .Borders.LineStyle = xlNone With .Interior .Pattern = xlNone .TintAndShade = 0 .PatternTintAndShade = 0 End With...

www.mrexcel.com

 

[johnnyL]

@Coyotex3 you marked that thread as solved already?

 

[Coyotex3]

@Coyotex3 you marked that thread as solved already?

Yes I did. Mumps gave me a wonderful reply which technically answered my question of making it more efficient. But someone else mentioned using variants(which I noticed you used on your sub) could make it much quicker and nearly instant apparently. Was hoping you could take a look and tell me what you thought.