Could you guys help me combine these macros yet again?

C

Coyotex3

Active Member
Joined
Dec 12, 2021
Messages
496
Office Version
  1. 365
Platform
  1. Windows
Trying to combine these 5 macros into one if possible

VBA Code: 
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
 

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
Sort by date Sort by votes
The simplest will be to run them all from a sixth macro
VBA Code: 
Sub RunAll()
  Coyote10
  Coyote12A
  Coyote13A
  Coyote14A
  Coyote15A
End Sub
 
Upvote 0
Dermot said:
The simplest will be to run them all from a sixth macro
VBA Code: 
Sub RunAll()
  Coyote10
  Coyote12A
  Coyote13A
  Coyote14A
  Coyote15A
End Sub
Click to expand...
That is what I have been doing actually, trying to make it into one sub if possible in order to clean everything up. I have way too many macros that are identical minus 1 tiny difference.
 
Upvote 0
Hi
'what about something like
VBA Code: 
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"
     Range("N" & i) = Range("J" & i).Value2 & ", " & Range("K" & i).Value2 & ", " & _
                         Range("L" & i).Value2 & " " & Range("M" & i).Value2
        Range("D" & i) = Range("C" & i).Value2 & 4
        Range("E" & i) = Range("C" & i).Value2 & 1
        Range("F" & i) = 201250
    
    For i = 2 To LR
        Range("I" & i) = Range("E" & i).Value2 & ", " & Range("F" & i).Value2 & ", " & _
                         Range("G" & i).Value2 & " " & Range("H" & i).Value2
        Range("N1").EntireColumn.Insert
        Range("N" & i) = Range("J" & i).Value2 & ", " & Range("K" & i).Value2 & ", " & _
        Range("L" & i).Value2 & " " & Range("M" & i).Value2
        Range("D" & i) = Range("C" & i).Value2 & 4
        Range("E" & i) = Range("C" & i).Value2 & 1
        Range("F" & i) = 201250
    
    Range("N1") = "City"
    Range("D1").EntireColumn.Insert
    Range("D1") = "Code"
    
    Range("E1").EntireColumn.Insert
    Range("E1") = "Alt Code"
    
    Range("F1").EntireColumn.Insert
    Range("F1") = "Extra Code"
    Next i
     Range("J1:M1").EntireColumn.Delete
    Range("E1:H1").EntireColumn.Delete
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
mohadin said:
Hi
'what about something like
VBA Code: 
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"
     Range("N" & i) = Range("J" & i).Value2 & ", " & Range("K" & i).Value2 & ", " & _
                         Range("L" & i).Value2 & " " & Range("M" & i).Value2
        Range("D" & i) = Range("C" & i).Value2 & 4
        Range("E" & i) = Range("C" & i).Value2 & 1
        Range("F" & i) = 201250
   
    For i = 2 To LR
        Range("I" & i) = Range("E" & i).Value2 & ", " & Range("F" & i).Value2 & ", " & _
                         Range("G" & i).Value2 & " " & Range("H" & i).Value2
        Range("N1").EntireColumn.Insert
        Range("N" & i) = Range("J" & i).Value2 & ", " & Range("K" & i).Value2 & ", " & _
        Range("L" & i).Value2 & " " & Range("M" & i).Value2
        Range("D" & i) = Range("C" & i).Value2 & 4
        Range("E" & i) = Range("C" & i).Value2 & 1
        Range("F" & i) = 201250
   
    Range("N1") = "City"
    Range("D1").EntireColumn.Insert
    Range("D1") = "Code"
   
    Range("E1").EntireColumn.Insert
    Range("E1") = "Alt Code"
   
    Range("F1").EntireColumn.Insert
    Range("F1") = "Extra Code"
    Next i
     Range("J1:M1").EntireColumn.Delete
    Range("E1:H1").EntireColumn.Delete
    Application.ScreenUpdating = True
End Sub
Click to expand...
Getting a method range of object global error on line

VBA Code: 
Range("N" & i) = Range("J" & i).Value2 & ", " & Range("K" & i).Value2 & ", " & _
 
Upvote 0
Sorry @Coyotex3, but I have run out of time playing with this for now. I need to get some sleep. The following is what I have shortened it to currently which should still be good:

VBA Code: 
Sub NewV2()
'
    Dim LR As Long, i As Long
'
    Application.ScreenUpdating = False
'
    LR = Range("A" & Rows.Count).End(xlUp).Row
'
'   Insert Column I, Combine E:H into I, Delete E:H, which leaves Column I as new Column E
    Range("I1").EntireColumn.Insert
    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
'
'   Insert Column N, Combine Column J:M into N, Delete J:M, which leaves Column N as new Column J
    Range("N1").EntireColumn.Insert
    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
'
    Range("D1:F1").EntireColumn.Insert
    For i = 2 To LR
        Range("D" & i) = Range("C" & i).Value2 & 4
        Range("E" & i) = Range("C" & i).Value2 & 1
        Range("F" & i) = 201250
    Next i
'
    Range("D1:F1").Value = Array("Code", "Alt Code", "Extra Code")
    Range("H1") = "Address"
    Range("M1") = "City"
'
    Application.ScreenUpdating = True
End Sub
 
Last edited:
Upvote 0
Solution
Hi
My mistake
Pasted twicw
try
VBA Code: 
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
        Range("N1").EntireColumn.Insert
        Range("N" & i) = Range("J" & i).Value2 & ", " & Range("K" & i).Value2 & ", " & _
                         Range("L" & i).Value2 & " " & Range("M" & i).Value2
        Range("D" & i) = Range("C" & i).Value2 & 4
        Range("E" & i) = Range("C" & i).Value2 & 1
        Range("F" & i) = 201250
    Next i
        Range("N1") = "City"
        Range("D1").EntireColumn.Insert
        Range("D1") = "Code"

        Range("E1").EntireColumn.Insert
        Range("E1") = "Alt Code"

        Range("F1").EntireColumn.Insert
        Range("F1") = "Extra Code"
    Range("J1:M1").EntireColumn.Delete
    Range("E1:H1").EntireColumn.Delete
    Application.ScreenUpdating = True
End Sub

Or
VBA Code: 
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("N1").EntireColumn.Insert
    Range("D1").EntireColumn.Insert
    Range("F1").EntireColumn.Insert
    Range("E1").EntireColumn.Insert
     Range("I1") = "Address": Range("N1") = "City":  Range("D1") = "Code":  Range("F1") = "Extra Code": Range("E1") = "Alt Code"
    For i = 2 To LR
        Range("I" & i) = Range("E" & i).Value2 & ", " & Range("F" & i).Value2 & ", " & _
                         Range("G" & i).Value2 & " " & Range("H" & i).Value2
        Range("N" & i) = Range("J" & i).Value2 & ", " & Range("K" & i).Value2 & ", " & _
                         Range("L" & i).Value2 & " " & Range("M" & i).Value2
        Range("D" & i) = Range("C" & i).Value2 & 4
        Range("E" & i) = Range("C" & i).Value2 & 1
        Range("F" & i) = 201250
    Next i
    Range("E1:H1").EntireColumn.Delete
    Range("J1:M1").EntireColumn.Delete
    Application.ScreenUpdating = True
End Sub
 
Last edited:
Upvote 0
johnnyL said:
Sorry @Coyotex3, but I have run out of time playing with this for now. I need to get some sleep. The following is what I have shortened it to currently which should still be good:

VBA Code: 
Sub NewV2()
'
    Dim LR As Long, i As Long
'
    Application.ScreenUpdating = False
'
    LR = Range("A" & Rows.Count).End(xlUp).Row
'
'   Insert Column I, Combine E:H into I, Delete E:H, which leaves Column I as new Column E
    Range("I1").EntireColumn.Insert
    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
'
'   Insert Column N, Combine Column J:M into N, Delete J:M, which leaves Column N as new Column J
    Range("N1").EntireColumn.Insert
    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
'
    Range("D1:F1").EntireColumn.Insert
    For i = 2 To LR
        Range("D" & i) = Range("C" & i).Value2 & 4
        Range("E" & i) = Range("C" & i).Value2 & 1
        Range("F" & i) = 201250
    Next i
'
    Range("D1:F1").Value = Array("Code", "Alt Code", "Extra Code")
    Range("H1") = "Address"
    Range("M1") = "City"
'
    Application.ScreenUpdating = True
End Sub
Click to expand...
This works thank you. I have one last macro I'm trying to optimize :)
 
Upvote 0
mohadin said:
Hi
My mistake
Pasted twicw
try
VBA Code: 
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
        Range("N1").EntireColumn.Insert
        Range("N" & i) = Range("J" & i).Value2 & ", " & Range("K" & i).Value2 & ", " & _
                         Range("L" & i).Value2 & " " & Range("M" & i).Value2
        Range("D" & i) = Range("C" & i).Value2 & 4
        Range("E" & i) = Range("C" & i).Value2 & 1
        Range("F" & i) = 201250
    Next i
        Range("N1") = "City"
        Range("D1").EntireColumn.Insert
        Range("D1") = "Code"

        Range("E1").EntireColumn.Insert
        Range("E1") = "Alt Code"

        Range("F1").EntireColumn.Insert
        Range("F1") = "Extra Code"
    Range("J1:M1").EntireColumn.Delete
    Range("E1:H1").EntireColumn.Delete
    Application.ScreenUpdating = True
End Sub

Or
VBA Code: 
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("N1").EntireColumn.Insert
    Range("D1").EntireColumn.Insert
    Range("F1").EntireColumn.Insert
    Range("E1").EntireColumn.Insert
     Range("I1") = "Address": Range("N1") = "City":  Range("D1") = "Code":  Range("F1") = "Extra Code": Range("E1") = "Alt Code"
    For i = 2 To LR
        Range("I" & i) = Range("E" & i).Value2 & ", " & Range("F" & i).Value2 & ", " & _
                         Range("G" & i).Value2 & " " & Range("H" & i).Value2
        Range("N" & i) = Range("J" & i).Value2 & ", " & Range("K" & i).Value2 & ", " & _
                         Range("L" & i).Value2 & " " & Range("M" & i).Value2
        Range("D" & i) = Range("C" & i).Value2 & 4
        Range("E" & i) = Range("C" & i).Value2 & 1
        Range("F" & i) = 201250
    Next i
    Range("E1:H1").EntireColumn.Delete
    Range("J1:M1").EntireColumn.Delete
    Application.ScreenUpdating = True
End Sub
Click to expand...
Thank you. These are not working properly for some reason. The first one is making a lot of extra blank columns and not copying the address or city, or extra code. The second one is also not copying the right columns.
 
Upvote 0
johnnyL said:
Sorry @Coyotex3, but I have run out of time playing with this for now. I need to get some sleep.
Click to expand...

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.

VBA Code: 
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
 
Upvote 0
You must log in or register to reply here.

Similar threads

B
  • Solved
VBA
Replies
5
Views
108
igold
igold
K
  • Solved
Update to existing Move data macro
2
Replies
11
Views
284
Alex Blakenburg
A
T
  • Solved
Apply Conditional Formatting Through VBA
Replies
2
Views
224
TaskMaster
T
S
  • Solved
Compare column A with several columns and copy the non-existent one
Replies
3
Views
193
Trebor76
T
D
  • Question
Data from one sheet to overide data on another sheet
Replies
0
Views
183
Daroh
D

Forum statistics

Threads
1,214,975
Messages
6,122,538
Members
449,088
Latest member
RandomExceller01

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