?
Solved

VBA code

Posted on 2013-12-19
11
Medium Priority
?
468 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 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
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

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 1500 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

New feature and membership benefit!

New feature! Upgrade and increase expert visibility of your issues with Priority Questions.

Question has a verified solution.

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

This article descibes how to create a connection between Excel and SAP and how to move data from Excel to SAP or the other way around.
When you see single cell contains number and text, and you have to get any date out of it seems like cracking our heads.
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.

765 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