VBA Worksheets and Ranges

p85ki

New Member
Joined
Nov 7, 2015
Messages
22
Hi all,

I have spent hours yesterday reading and watching youtube around worksheets/ranges and loops and I keep getting stuck and need any assistance if possible.

I have created a list of details of people against a particular team.
There are about 10 rows with about 30 bits of data in each column.
Where there is a specific text for some of the people they are highlighted via conditional formatting.
There are a 6 tabs that have the exact same layout.

In Excel I have this setup working absolutley fine so I have no issues, but realised that my biggest headache at the moment is the conditional formatting, for everytime something new needs to be added in, I need to do this against each of the 10 rows per tab. Therefore I now want to convert this into VBA.

It sounds 'straight forward' but I keep going round in a loop (pun intended :) ).

What do I need assistance with?

I need to set my ranges for the cells to go to the bottom of the dataset for each tab.
I felt below would be correct, but it appears to not go to the next worksheet.
Also I don't think the Vlookup is being dynamic to look at each row individually.

I guess my 2 questions are:

1) Can you provide some assistance in how to achieve this.
2) Is there any good tutorials I can watch. I keep seeing watching a few but it doesn't appear I can put a ws and range together to loop.

VBA Code:
Sub formatting()

Dim WrkSht As Worksheet
Set rng1 = Range("D5", "F33")


For Each WrkSht In ActiveWorkbook.Worksheets

With rng1

        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:="=VLOOKUP(rng1,Data_Details,COLUMNS(DATA!B:G),FALSE)=0"
        .Font.Color = vbBlack
        .Font.Bold = False
   
    End With

Next WrkSht

End Sub
 
Last edited by a moderator:

Snakehips

Well-known Member
Joined
May 17, 2009
Messages
5,224
Office Version
  1. 2013
Platform
  1. Windows
Ok. Give this a try and see if it is of value.
Test in a new dummy workbook. Click the Copy Icon on left of the below to copy and then paste into a new workbook.

Parameter sheet as below, with a limited number of notes / colours.
Edit the colours as you wish.

Book1-April.xlsm
AB
1NoteSet Colour Of Choice
2Newbie
3Team Lead
4Weekend Only
5FT - Own Rota
6PT - Own Rota
7PT - App Support
8Seconded Out
9
Parameter


This next sheet to be the first tab in the workbook
Book1-April.xlsm
CDEFGHIJK
4
5TomTeam LeadBorisTeam Lead
6FredWeekend OnlyJohn
7CharlieMaryWeekend Only
8SidPT - Own RotaDonald
9BillPT - App SupportSarahFT - Own Rota
10MarySeconded OutPhilPT - App Support
11SueNewbieTillySeconded Out
12
13FrankWeekend Only
14
1


This code in a code module.
VBA Code:
Sub Auto_CF_Snake()

Application.EnableEvents = False
Application.Calculation = xlCalculationManual

    'loop through c sheets  that are the  FIRST C sheets in the workbook!!!!!
   
    For Each Sht In ThisWorkbook.Sheets
        Sht.Activate
        c = c + 1
       
        Cells.FormatConditions.Delete
       
        Set DatRng = Range("D5:F33")  'Base Data range
       
        With DatRng
       
            For n = 1 To 9  'loop through 9  x 3column ranges (D:F  to  AJ:AL)
           
                CFLetter = DatRng.Cells(1, 3).Address(False, False) 'Get the column letter for 3rd column of range
                Set Params = Sheets("Parameter").Range("A2:B200")  ' assumes max 200 notes and colours
                LastPar = Params.Range("A200").End(xlUp).Row - 1   'Row of last note
               
                'Loop through notes and colours
                For r = 2 To LastPar  'loop through notes/colours in parameters
                    CFNote = Params.Cells(r, 1)  'note
                    CFCol = Params.Cells(r, 2).Interior.Color  'associated colour
                    CFForm = "=$" & CFLetter & "=" & Chr(34) & CFNote & Chr(34)  'CF Formula to colour based on note
                   
                        .FormatConditions.Add Type:=xlExpression, Formula1:=CFForm  'set formula
                        .FormatConditions(.FormatConditions.Count).SetFirstPriority
                        With .FormatConditions(1).Interior   'set interior colour
                            .PatternColorIndex = xlAutomatic
                            .Color = CFCol     ' appropriate colour
                            .TintAndShade = 0
                        End With
                        .FormatConditions(1).StopIfTrue = True   'set stop if true
                   
                 Next r  'next parameter row
                   
                  
                  Set DatRng = DatRng.Offset(0, 4)  'Next range
                   
            Next n 'next range
       
        End With
       
        If c = 1 Then GoTo Out   '<<<<<<<<<<<<  Set SHEETS LIMIT HERE  EDIT c to 6 for real workbook?
    Next Sht
Out:
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
End Sub

Run that code and it should establish 9 blocks of conditional formatting, 3 columns wide by 28 row deep on that first data sheet.

If you then want to add say 5 more blank data sheets, make sure they are the first 6 sheets in the workbook. Run the code and it should CF all 6 sheets.
It may not be the fastest of processing but I think it may get the job done a bit quicker than you or I could do it.
Fingers crossed.
 

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).

p85ki

New Member
Joined
Nov 7, 2015
Messages
22
Thank you so much Snakehips.

I'll be logging on later to look at this.
Your time and effort is so appreciated.

Have a great weekend and will let you know how this goes :)
 

Snakehips

Well-known Member
Joined
May 17, 2009
Messages
5,224
Office Version
  1. 2013
Platform
  1. Windows
Thank you so much Snakehips.

I'll be logging on later to look at this.
Your time and effort is so appreciated.

Have a great weekend and will let you know how this goes :)
(y) Just one minor tweak needed to that code, otherwise, it missing the first note/colour in the list.

Edit.
VBA Code:
For r = 2 To LastPar
to read
VBA Code:
 For r = 1 To LastPar
 

p85ki

New Member
Joined
Nov 7, 2015
Messages
22
Snakehips... Wow. Genuinley I am so amazed at how well this is working (not that I wasn't expecting it not to work) 😁
I am truely happy with the amount of hours this will save in the long run.

I have tampered with the code ever so slightly and it's working to perfection.

Thank you again for your amazing help. VBA is far from my strongest, although I know what I require, it's learning it. I tend to learn more from either being shown or comments against similar code and I have learnt so much through all the different codes you have gave me purely based on your notes which I absolutley love.
I have a habbit of my SQL to put comments on as a reminder of what each element is doing plus giving some help to other users who run the code that they know what it's doing, so I can't thank you enough.

It takes about 30 seconds for it to run. Yes it can be tweaked to go faster BUT to be honest I'd rather choose 30seconds over 1 or 2 hours :)

Thank you again for your amazing work and time to look at this! :)

Have a fantastic weekend.
 

p85ki

New Member
Joined
Nov 7, 2015
Messages
22

ADVERTISEMENT

Just to help, I changed the code from

VBA Code:
For Each Sht In ThisWorkbook.Sheet

To

VBA Code:
 For Each Sht In ActiveWorkbook.Worksheets(Array("Call Staff", "Email Staff", "Complaints Staff", "Cust Service", "Feedback Team", "Billing Department"))

This way I don't have to depend on those tabs being move. I plan to lockdown the tab names as the next phase :)
 

Snakehips

Well-known Member
Joined
May 17, 2009
Messages
5,224
Office Version
  1. 2013
Platform
  1. Windows
@p85ki You are welcome! I'm chuffed that it is going to help and that you have gained some vba knowledge from it.
Maybe this extra code might help if it's just a case of adding extra an occaisional additional entry to the Params list. It has to be done one entry at a time using cells D2:E2. But it will probably be quicker than having to run the previous, whole listing, code just for the sake of 1 or 2 add ins. Maybe test it and see?

Book1-April.xlsm
ABCDE
1NoteSet Colour Of ChoiceNew NoteNew Colour
2NewbieTest New 3
3Team Lead
4Weekend Only
5FT - Own Rota
6PT - Own Rota
7PT - App Support
8Seconded Out
9New Test
10Test Add 2
11
Parameter
Cells with Conditional Formatting
CellConditionCell FormatStop If True
D3:F12Expression=VLOOKUP($D3,Data_Details,7,FALSE)="App Support"textYES


Code to add single note/colour to CF
VBA Code:
Sub Auto_CF_Add()

Application.EnableEvents = False
Application.Calculation = xlCalculationManual

    'loop through c sheets  that are the  FIRST C sheets in the workbook!!!!!
    
    For Each Sht In ThisWorkbook.Sheets
        Sht.Activate
        c = c + 1
        
        Set DatRng = Range("D5:F33")  'Base Data range
        
        With DatRng
        
            For n = 1 To 9  'loop through 9  x 3column ranges (D:F  to  AJ:AL)
            
                CFLetter = DatRng.Cells(1, 3).Address(False, False) 'Get the column letter for 3rd column of range
                Set Params = Sheets("Parameter").Range("A2:B200")  ' assumes max 200 notes and colours
                LastPar = Params.Range("A200").End(xlUp).Row  'Row of last note
                
                'set new note and colour
                
                    CFNote = Sheets("Parameter").Range("D2") 'note
                    CFCol = Sheets("Parameter").Range("E2").Interior.Color 'associated colour
                    CFForm = "=$" & CFLetter & "=" & Chr(34) & CFNote & Chr(34)  'CF Formula to colour based on note
                    
                        .FormatConditions.Add Type:=xlExpression, Formula1:=CFForm  'set formula
                        .FormatConditions(.FormatConditions.Count).SetFirstPriority
                        With .FormatConditions(1).Interior   'set interior colour
                            .PatternColorIndex = xlAutomatic
                            .Color = CFCol     ' appropriate colour
                            .TintAndShade = 0
                        End With
                        .FormatConditions(1).StopIfTrue = True   'set stop if true
                    
                   
                  Set DatRng = DatRng.Offset(0, 4)  'Next range
                    
            Next n 'next range
        
        End With
        
        If c = 1 Then GoTo Out   '<<<<<<<<<<<<  Set SHEETS LIMIT HERE  EDIT c to 6 for real workbook?
    Next Sht
Out:
'add new to bottom of list
Sheets("Parameter").Cells(LastPar + 1, 1) = CFNote
Sheets("Parameter").Cells(LastPar + 1, 2).Interior.Color = CFCol
'Clear New
Sheets("Parameter").Range("D2").ClearContents
Sheets("Parameter").Range("E2").Interior.Color = 16777215

Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
End Sub
 

Snakehips

Well-known Member
Joined
May 17, 2009
Messages
5,224
Office Version
  1. 2013
Platform
  1. Windows

ADVERTISEMENT

Yes
Just to help, I changed the code from

VBA Code:
For Each Sht In ThisWorkbook.Sheet

To

VBA Code:
 For Each Sht In ActiveWorkbook.Worksheets(Array("Call Staff", "Email Staff", "Complaints Staff", "Cust Service", "Feedback Team", "Billing Department"))

This way I don't have to depend on those tabs being move. I plan to lockdown the tab names as the next phase :)
Yes. Good idea. The 1 to 6 was more for prototyping. (But I would say that, wouldn't I? ;))
 

Snakehips

Well-known Member
Joined
May 17, 2009
Messages
5,224
Office Version
  1. 2013
Platform
  1. Windows
Ignore the CF formula shown on that Param extract ^^^^^ it's irrelevant.
 

p85ki

New Member
Joined
Nov 7, 2015
Messages
22
@p85ki You are welcome! I'm chuffed that it is going to help and that you have gained some vba knowledge from it.
Maybe this extra code might help if it's just a case of adding extra an occaisional additional entry to the Params list. It has to be done one entry at a time using cells D2:E2. But it will probably be quicker than having to run the previous, whole listing, code just for the sake of 1 or 2 add ins. Maybe test it and see?

Book1-April.xlsm
ABCDE
1NoteSet Colour Of ChoiceNew NoteNew Colour
2NewbieTest New 3
3Team Lead
4Weekend Only
5FT - Own Rota
6PT - Own Rota
7PT - App Support
8Seconded Out
9New Test
10Test Add 2
11
Parameter
Cells with Conditional Formatting
CellConditionCell FormatStop If True
D3:F12Expression=VLOOKUP($D3,Data_Details,7,FALSE)="App Support"textYES

Thank you Snakehips.

I did think of a cheekier way that would work, although I think I may not go down that line of working just yet (not sure what code is needed yet although I can imagine it's simply playing about with what I have learnt so far) :)

1) When you first click on the Macro (I've created a button) - it runs the code as it is doing now.
2) The code can then copy the Notes and Colour code into a hidden tab.
3) When you click on the Macro button the 2nd time onwards, it will do a comparison between the hidden tab names and colour code and the parameter tab names and colour code:

a) If the names in both tabs exist and the colour are the same, ignore.
b) If the names in both exist but the colour are different, update the CF and also the hidden tab for that name.
c) If the name no longer exists on the parameter tab but exists in the hidden tab, delete the CF against each row, update the hidden list and colour code.
d) If there are new names in the parameter tab then proceed with carrying out the code and add this into the hidden list and colour code.

This way the paramater tab ultimatley controls what is meant to be shown at all times, and the hidden tab controls what was originally done by the code. ;)

Can't believe how much control you can have over VBA in a spreadsheet. I've worked on Spreadsheets for over 9 years and rarely used VBA to do anything. Not sure why I didn't go this way of learning. :|
 
Last edited:

Watch MrExcel Video

Forum statistics

Threads
1,132,702
Messages
5,654,820
Members
418,155
Latest member
demasisi

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
Top