Add

alialeola

New Member
Joined
Jul 6, 2022
Messages
21
Platform
  1. Windows
Hi guys,

After reading a lot around here and many beginner fails, I give up and kindly ask for your help with the below.
I need a macro to add specific values (let's say d/e/f) on the 2nd row after the last used column, in specific colors.

Help.png


Should be something like this, but something is definitely wrong.
Could you pls pls pls help?

Dim LastRow As Long
Dim LastCol As Long
Dim iRow As Long
Set ws = ActiveSheet

With ws
LastRow = .Cells(.Rows.Count, 2).End(xlUp).Row
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column

.Columns(LastCol + 1).EntireColumn.Insert
.Cells(2, LastCol + 1).Value = "d"
End with
.Cells(2, LastCol + 1).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 192
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
.Columns(LastCol + 2).EntireColumn.Insert
.Cells(2, LastCol + 2).Value = "e"
Cells(2, Columns.Count).End(xlToLeft).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 5296274
.TintAndShade = 0
.PatternTintAndShade = 0
End With
.Columns(LastCol + 3).EntireColumn.Insert
.Cells(2, LastCol + 3).Value = "f"
Cells(2, Columns.Count).End(xlToLeft).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 5296274
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End With
End Sub
 

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
Try the below:
VBA Code:
Sub test()
    Dim LastRow As Long
    Dim LastCol As Long
    Dim iRow As Long
    Dim ws As Worksheet
    
    Set ws = ActiveSheet
    
    With ws
        LastRow = .Cells(.Rows.Count, 2).End(xlUp).Row
        LastCol = .Cells(2, .Columns.Count).End(xlToLeft).Column ' needs to be a 2 due to headers start on row 2
        .Columns(LastCol + 1).EntireColumn.Insert
        With .Cells(2, LastCol + 1)
            .Value = "d"
            .Interior.Color = 192
            .Font.Color = vbWhite
        End With
        .Columns(LastCol + 2).EntireColumn.Insert
        With .Cells(2, LastCol + 2)
            .Value = "e"
            .Interior.Color = 15773696
            .Font.Color = vbWhite
        End With
        .Columns(LastCol + 3).EntireColumn.Insert
        With .Cells(2, LastCol + 3)
            .Value = "f"
            .Interior.Color = 5296274
            .Font.Color = vbWhite
        End With
    End With
End Sub
 
Upvote 0
Solution
Hope this helps.

VBA Code:
Sub sample()
Dim ws As Worksheet
Dim LastRow As Long
'Dim LastCol As Long
'Dim iRow As Long
Set ws = ActiveSheet

With ws
   ' LastRow = .Cells(.Rows.count, 2).End(xlUp).Row
    LastCol = .Cells(2, .Columns.count).End(xlToLeft).Column
    .Cells(2, LastCol + 1).Value = "d"
    .Cells(2, LastCol + 2).Value = "e"
    .Cells(2, LastCol + 3).Value = "f"
   
    .Cells(2, LastCol + 1).Interior.Color = RGB(192, 0, 0)
    .Cells(2, LastCol + 2).Interior.Color = RGB(0, 176, 240)
    .Cells(2, LastCol + 3).Interior.Color = RGB(146, 206, 80)
   
    With .Range(.Cells(2, LastCol + 1), .Cells(2, LastCol + 3))
        .Font.ThemeColor = xlThemeColorDark1
        .Font.TintAndShade = 0
        .HorizontalAlignment = xlCenter
    End With
   
End With
End Sub
 
Upvote 0
Or even this:
VBA Code:
Sub test()
    Dim LastCol As Long
    Dim arrCOL As Variant
    Dim arrVAL As Variant
    Dim x As Integer
    
    LastCol = Cells(2, Columns.Count).End(xlToLeft).Column
    
    arrVAL = Array("d", "e", "f")
    arrCOL = Array(192, 15773696, 5296274)
    
     For x = 1 To UBound(arrVAL) + 1
        With Cells(2, LastCol + x)
            .Value = arrVAL(x - 1)
            .Interior.Color = arrCOL(x - 1)
            .Font.ThemeColor = xlThemeColorDark1
            .Font.TintAndShade = 0
            .HorizontalAlignment = xlCenter
        End With
    Next x
End Sub
 
Upvote 0
Try the below:
VBA Code:
Sub test()
    Dim LastRow As Long
    Dim LastCol As Long
    Dim iRow As Long
    Dim ws As Worksheet
   
    Set ws = ActiveSheet
   
    With ws
        LastRow = .Cells(.Rows.Count, 2).End(xlUp).Row
        LastCol = .Cells(2, .Columns.Count).End(xlToLeft).Column ' needs to be a 2 due to headers start on row 2
        .Columns(LastCol + 1).EntireColumn.Insert
        With .Cells(2, LastCol + 1)
            .Value = "d"
            .Interior.Color = 192
            .Font.Color = vbWhite
        End With
        .Columns(LastCol + 2).EntireColumn.Insert
        With .Cells(2, LastCol + 2)
            .Value = "e"
            .Interior.Color = 15773696
            .Font.Color = vbWhite
        End With
        .Columns(LastCol + 3).EntireColumn.Insert
        With .Cells(2, LastCol + 3)
            .Value = "f"
            .Interior.Color = 5296274
            .Font.Color = vbWhite
        End With
    End With
End Sub
Thank you SO SO MUCH!

It worked just fine, much appreciated.
 
Upvote 0
Happy to help - I did also submit a shorter piece of code that does the same thing.
 
Upvote 0
Hope this helps.

VBA Code:
Sub sample()
Dim ws As Worksheet
Dim LastRow As Long
'Dim LastCol As Long
'Dim iRow As Long
Set ws = ActiveSheet

With ws
   ' LastRow = .Cells(.Rows.count, 2).End(xlUp).Row
    LastCol = .Cells(2, .Columns.count).End(xlToLeft).Column
    .Cells(2, LastCol + 1).Value = "d"
    .Cells(2, LastCol + 2).Value = "e"
    .Cells(2, LastCol + 3).Value = "f"
  
    .Cells(2, LastCol + 1).Interior.Color = RGB(192, 0, 0)
    .Cells(2, LastCol + 2).Interior.Color = RGB(0, 176, 240)
    .Cells(2, LastCol + 3).Interior.Color = RGB(146, 206, 80)
  
    With .Range(.Cells(2, LastCol + 1), .Cells(2, LastCol + 3))
        .Font.ThemeColor = xlThemeColorDark1
        .Font.TintAndShade = 0
        .HorizontalAlignment = xlCenter
    End With
  
End With
End Sub
This one works as well.

Thank you!!
 
Upvote 0

Forum statistics

Threads
1,214,653
Messages
6,120,751
Members
448,989
Latest member
mariah3

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