• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

How to I color last 5 column header using below vba

This is a part of a large vba script running and this part applies only for the header row
Couple of questions I have:
1) How do I color last 5 column header using below vba below
Range(Range("A1"), Range("A1").End(xlToRight)).Interior.ColorIndex = 15
Range(Range("A1"), Range("A1").End(xlToRight)).resize(1,-5) .Interior.ColorIndex = 40 <<<<< Need help here

2 Instead of above vba script using Range() how can I convert above script to using cells()
With ws.UsedRange.Columns
.Cells(1, .Columns.Count).End(xlToRight).Interior.ColorIndex =15 <<<<<< Need help in this line to select till last column and color

3) Also the same for last 6 columns
With ws.UsedRange.Columns
.Cells(1, .Columns.Count).End(xlToRight).resize(1,-5) . Interior.ColorIndex =40 <<<<<< Need help in this line to select till last column and color

A humble request to rookies : pls refrain from suggesting manual changes etc ...
 
cells(1,columns.count).end(xltoleft).offset(,-4).resize(,5)

Will complain if the last column is to the left of column E
Note xltoleft, not xltoright.
Add .entirecolumn for whole columns

use the likes of:
intersect(activesheet.usedrange,cells(1,columns.count).end(xltoleft).offset(,-4).resize(,5).entirecolumn)
to refer only to the used range of the sheet.
 
According to Excel Objects Model the obvious way to color the last five headers with another color than the previous headers :​
Code:
    With Ws.UsedRange.Columns
        .Cells(1).Resize(, .Count - 5).Interior.ColorIndex = 24
        .Cells(.Count - 4).Resize(, 5).Interior.ColorIndex = 40
Do you like it ? So thanks to click on bottom right Like !​
 
Thank you for this information very helpful . However I have a situation in my project Where I need to write a code "Set ws = Sheets("Billing Report") in the beginning of the code. But I noticed that my input flle has sheet name with "US Billing Report" or "CA Billings Report" so my script is not running for all input file. I cannot change the worksheet to Activesheet because the proceeding scripts is creating add new sheets and doing so work. So how do I resolve this .Is there a code which can write to take for a sheet name contain "Billing Report" for example . SET = Sheet.name like ("** Billing Report **") thank you. p45Cal & Marc L You have been a great help is my current project.
 
Yes it's possible via looping & checking worksheets names via Like for example …​
But maybe rather than a name it could be easier according to its index if it's always the same ?​
As a reminder creating such object variable is often useless …​
 
This is a small project which i have written with your help so far..

I have a situation in my project Where I need to write a code "Set ws = Sheets("Billing Report") in the beginning of the code. But I noticed that my input flle has sheet name with "US Billing Report" or "CA Billings Report" so my script is not running for all input file. I cannot change the worksheet to Activesheet because the proceeding scripts is creating add new sheets and doing so work. So how do I resolve this .Is there a code which can write to take for a sheet name contain "Billing Report" for example SET ws = Sheet.name like ("** Billing Report **")
Result will be like this with 2 sheets created. Below are the script which created for .Kindly run this and see how I can improve this script removing useless loops etc .Kindly use below script to test.
83559

>>> You've already noted with Your previous thread <<<
>>> use code - tags <<<
Code:
Sub Summary()
Application.ScreenUpdating = False
If ActiveSheet.Name <> "Billing Report" Then
Msgbox ("Change Sheet name to 'Billing Report'"): Exit Sub
End If
ActiveSheet.AutoFilterMode = False

Dim rSelection As Range
Dim qSelection As Range
Dim wsHQ As Worksheet, ws As Worksheet
Dim rng1 As Range
Dim rng2 As Range
ShtNames = Array("Account", "Billing")

   Set wsHQ = Sheets("Billing Report")    ' <<<<<<<<<< Need here to accomodate the sheet says "US Billing Report" or "CA Billings Report".
   'Set ws = Sheets("Ledger Miscode Query")
    Const C = "&""-""&"
    'wsHQ.AutoFilterMode = False
    With wsHQ.UsedRange.Columns
        
         v = Application.Match([{"Lab","Operations","Finance","Systems"}], .Rows(1), 0)
         'If Application.Count(v) <> 3 Then Beep: Exit Sub
         If Application.Count(v) <> 4 Then Msgbox ("Matching columns not found!!"): Exit Sub
         .Cells(1, .Count + 1) = ">>"
         .Cells(1, .Count + 2) = "Billing"
         .Cells(1, .Count + 3) = "Account"
         .Cells(1, .Count + 4) = "Check1"
         .Cells(1, .Count + 5) = "Check2"
        .Item(.Count + 2) = .Parent.Evaluate(.Item(v(1)).Address & C & .Item(v(2)).Address & C & .Item(v(3)).Address)
        .Cells(1, .Count + 2) = "Billing"
        .Item(.Count + 3) = .Parent.Evaluate(.Item(v(1)).Address & C & .Item(v(2)).Address & C & .Item(v(4)).Address)
        .Cells(1, .Count + 3) = "Account"
        .Cells(1).Resize(, .Count + 5).Interior.ColorIndex = 15
        .Cells(.Count).Offset(0, 1).Resize(, 5).Interior.ColorIndex = 40
        .Cells(1).Resize(, .Count + 5).Font.Bold = True
        .Item(.Count).Offset(0, 2).Resize(, 4).AutoFit
        End With
       
    wsHQ.AutoFilterMode = False
    wsHQ.UsedRange.AutoFilter

For Each ShtName In ShtNames
  Set rSelection = wsHQ.Rows("1").Find(ShtName, , xlValues, xlWhole, , , True)
  If Not Evaluate("isref('" & ShtName & "'!A1)") Then
    On Error Resume Next
    Range(rSelection, rSelection.End(xlDown)).Copy
    Set ws = Worksheets.add(After:=wsHQ)
    ws.Name = ShtName
    With ws
      With .Range("A1")
        .PasteSpecial xlPasteValues
        .PasteSpecial xlPasteFormats
        '.PasteSpecial xlPasteValuesAndNumberFormats
      End With
     
     .UsedRange.RemoveDuplicates Columns:=1, Header:=xlYes
      On Error Resume Next
     .UsedRange.SpecialCells(xlCellTypeBlanks).Delete Shift:=xlShiftUp
     On Error GoTo 0
      'Autofit column
     .Columns("A").AutoFit
    End With
  End If
 
  Set ws = Sheets(ShtName)
  With ws
    lr = wsHQ.Cells(Cells.Rows.Count, rSelection.Column).End(xlUp).Row
    lRow = .Cells(Cells.Rows.Count, "A").End(xlUp).Row
   
    Set rng = rSelection.Offset(1).Resize(lr - 1)

    .Range("A1").Copy .Range("B1")
    .Range("B1") = "Rows"
    .Range("B2:B" & lRow).Formula = "=COUNTIF('" & wsHQ.Name & "'!" & rng.Address & ",A2)"
    .Range("B2:B" & lRow).Value = .Range("B2:B" & lRow).Value
     On Error Resume Next
    Set rng1 = .Range(.Range("A1"), .Range("B1").End(xlDown))
    rng1.Sort key1:=.Range("B1"), order1:=xlDescending, Header:=xlYes
    Range("A1").Select
  End With
  Next ShtName
wsHQ.Activate
'wsHQ.RefreshAll
Application.ScreenUpdating = True


End Sub
 

Attachments

  • ConcatenateBilling.xlsx
    11.9 KB · Views: 1
Last edited by a moderator:
You mention it could be Billing or Billings so you could look for the inclusion of billing and report. The lcase ensures it's case insensitive):
Code:
For Each ws In Worksheets    'you should qualify Worksheets with the workbook really.
  If (InStr(LCase(ws.Name), "billing") > 0) And (InStr(LCase(ws.Name), "report") > 0) Then
    'the rest of your code here
  End if
Next ws
 
According to post #6 attachment as there is a single worksheet within the workbook​
so this statement well does the job : With ActiveSheet … No matters new worksheets added after !​
 
According to post #6 attachment as there is a single worksheet within the workbook​
so this statement well does the job : With ActiveSheet … No matters new worksheets added after !​
Thank you Marc. Set wsHQ = ActiveSheet actually did the trick.. I was clouded by the thoughts that setting wsHQ = Activesheet cannot return the scripts to back its original sheet where it started and will stay in the sheet whenever a new sheet is created..But it was not as I thought. It fixed my problem. thanks for the guidance.

this project is basically creating a countif function of occurrences in a separate sheet based on its column name. It first concatenate columns E & F & G Under "Billing" and E & F & H under Column name " Account" and then create a summary sheets based on "Billing" & "Account" and count the occurrences . With the last part problem solved I think this is ready to go. Thanks Marc and P45Cal for your kind support in automating my long wishing task .
 
Jonnathanjons
You've noted few time that You've not used code - tags.
What to do
Please reread pages
New Users - Please Start Here
There are many links witch should give useful information
Especially from
to this specific case.
 
Back
Top