Solved

VBA code

Posted on 2013-12-19
11
455 Views
Last Modified: 2013-12-20
Hi guys,

I have a report in which in first field are stored numbers and in the second field are stored names. The other fields are not important in the context of my question.
I use the below VBA code for dividing this report in more Excel files, every file containing the records used for only one name from the second field.
I would like, if it is possible,  to have this code updated so that each resulting file (after splitting) has the records filled in red if the numbers in the first field are greater or equal to 4.

Thank you

Sub divide()
    'declare variables
    Dim campus As String
    Dim campusBegin As Double
    Dim campusEnd As Double
    Dim path As String
    Dim SheetName As String
    Dim bookName As String
    Dim newBookName As String
    Dim header As Integer
    Dim cRow As String
    Dim border As Integer
    Dim rBound As String
    Dim count As Long
    Dim back As Long
    Dim icolor As Integer
    back = 0
    count = 0
       
    header = InputBox("Please enter the number header rows: ", "User Input Needed")
    campusBegin = header + 1
    campusEnd = campusBegin
   
    cRow = InputBox("Please enter the letter of the campus number column:")
    rBound = InputBox("Please enter the letter of the last column to the right:")
    newBookName = InputBox("Please enter 'Save As' file name:", "Save File Name")
    newBookName = newBookName & " "
       
    'initialize variables
    'path = "C:\Documents and Settings\Administrator\Desktop\By Loc"
    path = ActiveWorkbook.path
    path = path & "\By Loc"
    MkDir (path)
    SetAttr path, vbNormal
    SheetName = ActiveSheet.Name
    bookName = ActiveWorkbook.Name
   
    'campus range - data rows
    Do Until Range(cRow & campusEnd).Value = Empty
        campus = Range(cRow & campusBegin).Value
       
        'select campus data
        Do Until Range(cRow & campusEnd).Value <> campus
            campusEnd = campusEnd + 1
            count = count + 1
        Loop
   
        campusEnd = campusEnd - 1
   
        'header row
        Range("A1:" & rBound & header).Copy
        Workbooks.Add
        Columns("A:A").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("A:A").ColumnWidth
        Columns("B:B").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("B:B").ColumnWidth
        Columns("C:C").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("C:C").ColumnWidth
        Columns("D:D").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("D:D").ColumnWidth
        Columns("E:E").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("E:E").ColumnWidth
        Columns("F:F").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("F:F").ColumnWidth
        Columns("G:G").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("G:G").ColumnWidth
        Columns("H:H").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("H:H").ColumnWidth
        Columns("I:I").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("I:I").ColumnWidth
        Columns("J:J").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("J:J").ColumnWidth
        Columns("K:K").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("K:K").ColumnWidth
        Columns("L:L").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("L:L").ColumnWidth
        Columns("M:M").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("M:M").ColumnWidth
        Columns("N:N").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("N:N").ColumnWidth
        Columns("O:O").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("O:O").ColumnWidth
        Columns("P:P").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("P:P").ColumnWidth
        Columns("Q:Q").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("Q:Q").ColumnWidth
        Columns("R:R").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("R:R").ColumnWidth
        Columns("S:S").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("S:S").ColumnWidth
        Columns("T:T").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("T:T").ColumnWidth
        Columns("U:U").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("U:U").ColumnWidth
        Columns("V:V").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("V:V").ColumnWidth
        Columns("W:W").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("W:W").ColumnWidth
        Columns("X:X").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("X:X").ColumnWidth
        Columns("Y:Y").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("Y:Y").ColumnWidth
        Columns("Z:Z").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("Z:Z").ColumnWidth
        Columns("AA:AA").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("AA:AA").ColumnWidth
        Columns("AB:AB").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("AB:AB").ColumnWidth
        Columns("AC:AC").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("AC:AC").ColumnWidth
        Columns("AD:AD").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("AD:AD").ColumnWidth
        Columns("AE:AE").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("AE:AE").ColumnWidth
        Columns("AF:AF").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("AF:AF").ColumnWidth
        Columns("AG:AG").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("AG:AG").ColumnWidth
        Columns("AH:AH").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("AH:AH").ColumnWidth
        Columns("AI:AI").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("AI:AI").ColumnWidth
        Columns("AJ:AJ").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("AJ:AJ").ColumnWidth
        Columns("AK:AK").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("AK:AK").ColumnWidth
        Columns("AL:AL").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("AL:AL").ColumnWidth
        Columns("AM:AM").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("AM:AM").ColumnWidth
        Columns("AN:AN").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("AN:AN").ColumnWidth
        Columns("AO:AO").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("AO:AO").ColumnWidth
        Columns("AP:AP").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("AP:AP").ColumnWidth
        Columns("AQ:AQ").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("AQ:AQ").ColumnWidth
        Columns("AR:AR").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("AR:AR").ColumnWidth
        Columns("AS:AS").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("AS:AS").ColumnWidth
        Columns("AT:AT").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("AT:AT").ColumnWidth
        Columns("AU:AU").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("AU:AU").ColumnWidth
        Columns("AV:AV").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("AV:AV").ColumnWidth
        Columns("AW:AW").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("AW:AW").ColumnWidth
        Columns("AX:AX").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("AX:AX").ColumnWidth
        Columns("AY:AY").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("AY:AY").ColumnWidth
        Columns("AZ:AZ").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("AZ:AZ").ColumnWidth
        Columns("BA:BA").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("BA:BA").ColumnWidth
        Columns("BB:BB").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("BB:BB").ColumnWidth
        Columns("BC:BC").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("BC:BC").ColumnWidth
        Columns("BD:BD").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("BD:BD").ColumnWidth
        Columns("BE:BE").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("BE:BE").ColumnWidth
        Columns("BF:BF").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("BF:BF").ColumnWidth
        Columns("BG:BG").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("BG:BG").ColumnWidth
        Columns("BH:BH").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("BH:BH").ColumnWidth
        Columns("BI:BI").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("BI:BI").ColumnWidth
        Columns("BJ:BJ").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("BJ:BJ").ColumnWidth
        Columns("BK:BK").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("BK:BK").ColumnWidth
        Columns("BL:BL").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("BL:BL").ColumnWidth
        Columns("BM:BM").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("BM:BM").ColumnWidth
        Columns("BN:BN").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("BN:BN").ColumnWidth
        Columns("BO:BO").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("BO:BO").ColumnWidth
        Columns("BP:BP").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("BP:BP").ColumnWidth
        Columns("BQ:BQ").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("BQ:BQ").ColumnWidth
        Columns("BR:BR").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("BR:BR").ColumnWidth
        Columns("BS:BS").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("BS:BS").ColumnWidth
        Columns("BT:BT").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("BT:BT").ColumnWidth
        Columns("BU:BU").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("BU:BU").ColumnWidth
        Columns("BV:BV").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("BV:BV").ColumnWidth
        Columns("BW:BW").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("BW:BW").ColumnWidth
        Columns("BX:BX").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("BX:BX").ColumnWidth
        Columns("BY:BY").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("BY:BY").ColumnWidth
        Columns("BZ:BZ").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("BZ:BZ").ColumnWidth
        Columns("CA:CA").ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns("CA:CA").ColumnWidth
        ActiveSheet.Paste
        Range("A" & header + 1).Select
        ActiveSheet.Name = "Loc " & campus
        ActiveWorkbook.SaveAs path & "\" & newBookName & campus
        Workbooks(bookName).Activate
        Sheets(SheetName).Select
       
        'data rows
        Range("A" & campusBegin & ":" & rBound & campusEnd).Select
        Selection.Copy
        Workbooks(newBookName & campus & ".xlsx").Activate
        Sheets("Loc " & campus).Select
        ActiveSheet.Paste
       
        'format
        Cells.Select
        Cells.EntireColumn.AutoFit
        Columns("H:H").Select
        Selection.ColumnWidth = 10
        Columns("I:I").Select
        Selection.ColumnWidth = 10
        Columns("M:M").Select
        Selection.ColumnWidth = 8
        Columns("N:N").Select
        Selection.ColumnWidth = 8
        Columns("O:O").Select
        Selection.ColumnWidth = 8
        Columns("P:P").Select
        Selection.ColumnWidth = 8
        Columns("U:U").Select
        Selection.ColumnWidth = 23
        Columns("AA:AA").Select
        Selection.ColumnWidth = 23
        Columns("AG:AG").Select
        Selection.ColumnWidth = 23
        Columns("AM:AM").Select
        Selection.ColumnWidth = 23
        Columns("AS:AS").Select
        Selection.ColumnWidth = 23
        Columns("AY:AY").Select
        Selection.ColumnWidth = 23
        Columns("BE:BE").Select
        Selection.ColumnWidth = 23
        Columns("BK:BK").Select
        Selection.ColumnWidth = 23
        Columns("BQ:BQ").Select
        Selection.ColumnWidth = 23
        Columns("BW:BW").Select
        Selection.ColumnWidth = 23
               
       
       
       
        With ActiveWindow
            .SplitColumn = 0
            .SplitRow = header
        End With
        ActiveWindow.FreezePanes = True
       
'        ActiveWindow.Zoom = 85
       
        Range("A1:" & rBound & "1").Select
        Selection.AutoFilter
'        ActiveSheet.Protect Password:="DataDriven", DrawingObjects:=True, Contents:=True, Scenarios:=True _
'            , AllowFiltering:=True
'        ActiveSheet.EnableSelection = xlNoSelection
       
'       Insert formatting code here
With ActiveSheet.PageSetup
        .PrintTitleRows = "$1:$1"
        .PrintTitleColumns = ""
    End With
    ActiveSheet.PageSetup.PrintArea = ""
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0)
        .RightMargin = Application.InchesToPoints(0)
        .TopMargin = Application.InchesToPoints(0.5)
        .BottomMargin = Application.InchesToPoints(0.5)
        .HeaderMargin = Application.InchesToPoints(0)
        .FooterMargin = Application.InchesToPoints(0)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperLetter
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 100
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
'       -------------------------------------------------
   
        Range("A1").Select
        ActiveWorkbook.Save
        ActiveWorkbook.Close
        Sheets(SheetName).Select
        campusBegin = campusEnd + 1
        campusEnd = campusBegin
        back = back + count
        count = 0
    Loop
   
    'deselect the selection and display confirmation
    Sheets(SheetName).Range("A1").Select
    MsgBox "Operation Successful!"
   
End Sub
0
Comment
Question by:marian68
  • 7
  • 4
11 Comments
 
LVL 43

Expert Comment

by:Saqib Husain, Syed
ID: 39730017
See if this works. I have also reduced the large chunks of code. More can be reduced.

Sub divide()
    'declare variables
    Dim campus As String
    Dim campusBegin As Double
    Dim campusEnd As Double
    Dim path As String
    Dim SheetName As String
    Dim bookName As String
    Dim newBookName As String
    Dim header As Integer
    Dim cRow As String
    Dim border As Integer
    Dim rBound As String
    Dim count As Long
    Dim back As Long
    Dim icolor As Integer
    back = 0
    count = 0
       
    header = InputBox("Please enter the number header rows: ", "User Input Needed")
    campusBegin = header + 1
    campusEnd = campusBegin
    
    cRow = InputBox("Please enter the letter of the campus number column:")
    rBound = InputBox("Please enter the letter of the last column to the right:")
    newBookName = InputBox("Please enter 'Save As' file name:", "Save File Name")
    newBookName = newBookName & " "
       
    'initialize variables
    'path = "C:\Documents and Settings\Administrator\Desktop\By Loc"
    path = ActiveWorkbook.path
    path = path & "\By Loc"
    MkDir (path)
    SetAttr path, vbNormal
    SheetName = ActiveSheet.Name
    bookName = ActiveWorkbook.Name
   
    'campus range - data rows
    Do Until Range(cRow & campusEnd).Value = Empty
        campus = Range(cRow & campusBegin).Value
       
        'select campus data
        Do Until Range(cRow & campusEnd).Value <> campus
            campusEnd = campusEnd + 1
            count = count + 1
        Loop
   
        campusEnd = campusEnd - 1
   
        'header row
        Range("A1:" & rBound & header).Copy
        Workbooks.Add
        For Each col In Range("A:CA").Columns
            Columns(col.Address).ColumnWidth = Workbooks(bookName).Sheets(SheetName).Columns(col.Address).ColumnWidth
        Next col
        ActiveSheet.Paste
        Range("A" & header + 1).Select
        ActiveSheet.Name = "Loc " & campus
        ActiveWorkbook.SaveAs path & "\" & newBookName & campus
        Workbooks(bookName).Activate
        Sheets(SheetName).Select
       
        'data rows
        Range("A" & campusBegin & ":" & rBound & campusEnd).Select
        Selection.Copy
        Workbooks(newBookName & campus & ".xlsx").Activate
        Sheets("Loc " & campus).Select
        ActiveSheet.Paste
    Selection.CurrentRegion.FormatConditions.Add Type:=xlExpression, Formula1:="=$A" & Selection.Row & ">=4"
    Selection.CurrentRegion.FormatConditions(Selection.FormatConditions.count).SetFirstPriority
    With Selection.CurrentRegion.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 255
        .TintAndShade = 0
    End With
    Selection.CurrentRegion.FormatConditions(1).StopIfTrue = False
        'format
        Cells.Select
        Cells.EntireColumn.AutoFit
        Columns("H:I").ColumnWidth = 10
        Columns("M:P").ColumnWidth = 8
        Columns("U:U,AA:AA,AG:AG,AM:AM,AS:AS,AY:AY,BE:BE,BK:BK,BQ:BQ,BW:BW").ColumnWidth = 23
               
       
       
       
        With ActiveWindow
            .SplitColumn = 0
            .SplitRow = header
        End With
        ActiveWindow.FreezePanes = True
       
'        ActiveWindow.Zoom = 85
       
        Range("A1:" & rBound & "1").Select
        Selection.AutoFilter
'        ActiveSheet.Protect Password:="DataDriven", DrawingObjects:=True, Contents:=True, Scenarios:=True _
'            , AllowFiltering:=True
'        ActiveSheet.EnableSelection = xlNoSelection
       
'       Insert formatting code here
            With ActiveSheet.PageSetup
                .PrintTitleRows = "$1:$1"
                .PrintTitleColumns = ""
            End With
            ActiveSheet.PageSetup.PrintArea = ""
            With ActiveSheet.PageSetup
                .LeftHeader = ""
                .CenterHeader = ""
                .RightHeader = ""
                .LeftFooter = ""
                .CenterFooter = ""
                .RightFooter = ""
                .LeftMargin = Application.InchesToPoints(0)
                .RightMargin = Application.InchesToPoints(0)
                .TopMargin = Application.InchesToPoints(0.5)
                .BottomMargin = Application.InchesToPoints(0.5)
                .HeaderMargin = Application.InchesToPoints(0)
                .FooterMargin = Application.InchesToPoints(0)
                .PrintHeadings = False
                .PrintGridlines = False
                .PrintComments = xlPrintNoComments
                .PrintQuality = 600
                .CenterHorizontally = False
                .CenterVertically = False
                .Orientation = xlLandscape
                .Draft = False
                .PaperSize = xlPaperLetter
                .FirstPageNumber = xlAutomatic
                .Order = xlDownThenOver
                .BlackAndWhite = False
                .Zoom = 100
                .PrintErrors = xlPrintErrorsDisplayed
                .OddAndEvenPagesHeaderFooter = False
                .DifferentFirstPageHeaderFooter = False
                .ScaleWithDocHeaderFooter = True
                .AlignMarginsHeaderFooter = True
                .EvenPage.LeftHeader.Text = ""
                .EvenPage.CenterHeader.Text = ""
                .EvenPage.RightHeader.Text = ""
                .EvenPage.LeftFooter.Text = ""
                .EvenPage.CenterFooter.Text = ""
                .EvenPage.RightFooter.Text = ""
                .FirstPage.LeftHeader.Text = ""
                .FirstPage.CenterHeader.Text = ""
                .FirstPage.RightHeader.Text = ""
                .FirstPage.LeftFooter.Text = ""
                .FirstPage.CenterFooter.Text = ""
                .FirstPage.RightFooter.Text = ""
            End With
'       -------------------------------------------------
   
        Range("A1").Select
        ActiveWorkbook.Save
        ActiveWorkbook.Close
        Sheets(SheetName).Select
        campusBegin = campusEnd + 1
        campusEnd = campusBegin
        back = back + count
        count = 0
    Loop
   
    'deselect the selection and display confirmation
    Sheets(SheetName).Range("A1").Select
    MsgBox "Operation Successful!"
   
End Sub

Open in new window

0
 

Author Comment

by:marian68
ID: 39730061
It doesn't work. It stops at first name.
It is highlighted the line of code
Columns("U:U,AA:AA,AG:AG,AM:AM,AS:AS,AY:AY,BE:BE,BK:BK,BQ:BQ,BW:BW").ColumnWidth = 23
Thank you ssaqibh
0
 
LVL 43

Expert Comment

by:Saqib Husain, Syed
ID: 39730138
Ok just forget about my code for the moment and try adding these lines

    Selection.CurrentRegion.FormatConditions.Add Type:=xlExpression, Formula1:="=$A" & Selection.Row & ">=4"
    Selection.CurrentRegion.FormatConditions(Selection.FormatConditions.count).SetFirstPriority
    With Selection.CurrentRegion.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 255
        .TintAndShade = 0
    End With
    Selection.CurrentRegion.FormatConditions(1).StopIfTrue = False

Open in new window

before this line

        'format
0
Free Tool: Postgres Monitoring System

A PHP and Perl based system to collect and display usage statistics from PostgreSQL databases.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 

Author Comment

by:marian68
ID: 39730248
It partially works.
If I have 7 records in a report where numbers in field1 are greater or equal with 4 the code will fill in red only 6 records plus the heading of the report.
Thank you
0
 

Author Comment

by:marian68
ID: 39730259
If I have only 1 record in a report where numbers in field1 are greater or equal with 4 the code will fill in red only the headings.
Thank you
0
 

Author Comment

by:marian68
ID: 39730843
Can anyone help me?
Thank you
0
 
LVL 43

Accepted Solution

by:
Saqib Husain, Syed earned 500 total points
ID: 39730906
Change that to

    With Selection.CurrentRegion.Offset(header + 1)
        .FormatConditions.Add Type:=xlExpression, Formula1:="=$A" & .Row & ">=4"
        .FormatConditions(Selection.FormatConditions.count).SetFirstPriority
        With .FormatConditions(1).Interior
            .PatternColorIndex = xlAutomatic
            .Color = 255
            .TintAndShade = 0
        End With
        .FormatConditions(1).StopIfTrue = False
    End With
0
 

Author Comment

by:marian68
ID: 39730944
It doesn't work.
It stops and the code highlighted is:
 .FormatConditions(Selection.FormatConditions.count).SetFirstPriority

Anyway I checked 1 file already divided and now the first line under headings with the biggest number is not in red. It starts with the second record.

Thank you
0
 
LVL 43

Expert Comment

by:Saqib Husain, Syed
ID: 39731077
replace header+1 with header. This should take care of the first line not being highlighted.

For the error try deleting the word selection leaving behind

...(.formatconditions....

It would be easier if you uploaded a small sample(fake?)
0
 

Author Comment

by:marian68
ID: 39731479
It doesn't work at all. I did what you said but now it stops at first name.
The same code line is highlighted:
 .FormatConditions(FormatConditions.count).SetFirstPriority

Thak you
0
 

Author Comment

by:marian68
ID: 39731632
I deleted the line of code :
FormatConditions(FormatConditions.count).SetFirstPriority
and now it works.
0

Featured Post

Networking for the Cloud Era

Join Microsoft and Riverbed for a discussion and demonstration of enhancements to SteelConnect:
-One-click orchestration and cloud connectivity in Azure environments
-Tight integration of SD-WAN and WAN optimization capabilities
-Scalability and resiliency equal to a data center

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Drop Down List with Unique/Distinct Values (Part II - ComboBox or ListBox and Data Validation List Bonus!) David Miller (dlmille) Intro This article focuses on delivering unique, sorted lists to list objects (e.g., ComboBox, ListBox) and Dat…
Workbook link problems after copying tabs to a new workbook? David Miller (dlmille) Intro Have you either copied sheets to a new workbook, and after having saved and opened that workbook, you find that there are links back to the original sou…
The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.

856 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question