Free Microsoft Excel 2013 Quick Reference

Selection interior colorindex Results

Have a worksheet:
_____| A |____| B |___
1____| z3 |____| z1 |___
2____| z8 |____| z2 |___
3____| z9 |____| z3 |___
4____| zd |____| z4 |___
5____| zb |____| z5 |___
6____|___|___|___|___

Want to copy the value in cell A5, cntrl-H to change the value in that relative cell to the value in the relative cell B5. When done, I change the color of cell A5 and move up to cell A4 and stop.

I recorded this macro with the relative cell positioning switch turned on.

It works fine for the first set of cells, but each time I execute it thereafter it moves up to the next cell above and changes the color only.
    ActiveCell.Offset(-1, 0).Range("A1").Select
    Selection.Copy
    ActiveCell.Offset(0, 1).Range("A1").Select
    Application.CutCopyMode = False
    Selection.Copy
    Cells.Replace What:="REQZ277", Replacement:="REQ_F_290", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=True, _
        ReplaceFormat:=False
    ActiveCell.Offset(0, -1).Range("A1").Select
    Selection.Interior.ColorIndex = 35
End Sub


http://www.iimmgg.com/image/b62363df...bc96dfe25e2c87
The image above shows how my worksheet looks like initially. What i want to do now is to add simple designs to this worksheets.

Step1
Look for the first cell in column A that contains “count”, once detected need to do the add the following codes:
Selection.Font.Bold = True
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
End With take alook at the image below:
http://www.iimmgg.com/image/49bcfeab...45b46c5dfcde02

Step 2:
For the next cell in column A that contains “count”, do the following step for the entire row
Selection.Font.Bold = True
Selection.Font.ColorIndex = 9 Step 3
Keep repeating the above two steps until the macro detect a cell containing “Grand Count” in column A
For the row that contains “Grand Count”, do the following step
Selection.Font.ColorIndex = 5
Selection.Font.Bold = True take a look at the image:
http://www.iimmgg.com/image/0cc57395...fea44ae4170e1b

The final outcome should look like the image below:
http://www.iimmgg.com/image/a7ac9e27...b5e74d5e206356

I have attached a sample workbook.
Sheet 1 shows how the initial worksheet looks like.
Sheet 2 shows how the final outcome should look like
design.xls

Hi,

I have added constrains so that the user has to reselect a period, see code below.

I want to add two more constrains: user need to reselect in case:

1) His selection consists of a single AND merged cells, or MORE couple of merged cells together.

Actually, I need a rule that ONLY one couple of merged cells are allowed to be selected for further process.

2) The text "Office" is part of the (meged) cells that he selected.

Private Sub CmdChangeStatus_Click()
On Error GoTo error_handler
RepeatInputBox1:
Set srng = Application.InputBox(prompt:="Select Task To Get Updated Status", Left:=30, Top:=80, Type:=8)
With srng
    If srng.Rows.Count > 1 Then ' limit cell selection
    Set srng = Nothing
    MsgBox "This is not a Task!"
    GoTo RepeatInputBox1
    End If
    If .MergeCells = False Then ' limit cell selection
    Set srng = Nothing
    MsgBox "This is not a Task!"
    GoTo RepeatInputBox1
    End If
    If srng.Columns.Count > 1 Then ' limit cell selection
    Set srng = Nothing
    MsgBox "Select a Task, not a Period!"
    GoTo RepeatInputBox1
    End If
  Status = LCase(Range("$a$16").Value)
  Select Case Status
     Case Is = "proposed": srng.Interior.ColorIndex = 8
     Case Is = "scheduled": srng.Interior.ColorIndex = 37
     Case Is = "confirmed": srng.Interior.ColorIndex = 33
     Case Else: srng.Interior.ColorIndex = xlNone
  End Select
End With
        ActiveSheet.Range("$a$16").Select
error_handler:
Exit Sub
End Sub


Here's a snippet of my code that is driving me nuts. I feel it should be simple (and work as I have it), but I get a 400 error because it doesn't like something.

The if/or lines that I have dormant will work, but I was trying to use select case instead to avoid having a huge if statement for ten color conditions. What is it that is giving the select case fits?

Thanks.

Color1 = Range("c1").Interior.Color
Color2 = Range("d1").Interior.Color
Color3 = Range("e1").Interior.Color
Color4 = Range("f1").Interior.Color
Color5 = Range("g1").Interior.Color
Color6 = Range("h1").Interior.Color
Color7 = Range("i1").Interior.Color
Color8 = Range("j1").Interior.Color
Color9 = Range("k1").Interior.Color
Color10 = Range("l1").Interior.Color

Set ColorRange = Selection.Resize(RowRangeCount, LastColumn)


    For Each CellCheck In ColorRange 'for all cells that are filled white, clear contents after paste
'        If CellCheck.Interior.ColorIndex = 2 Or CellCheck.Interior.Color = 13434879 Then
'            CellCheck.ClearContents
'        End If
        Select Case CellCheck.Interior.Color
            Case Color1, Color2, Color3, Color4, Color5, _
                Color6, Color7, Color8, Color9, Color10
                    CellCheck.ClearContents
        End Select
    Next CellCheck


Hi all,
I don't know what is happening with this bit of code but it started to go wrong today and the code has been working up until today. The purpose of the following code is to clean and clear my insert page, set a hyperlink to an index page, and then tell the user where to paste the new data upon the next update.

Sub CleanInsert()
''''This module cleans the Insert worksheet and prepares it for the next''''
''''available update.
''''August 5, 2010.''''

Dim bln As Boolean
bln = Application.ScreenUpdating
Application.ScreenUpdating = False
Application.Worksheets("Insert").Select

Range("InsertCleanBox").Select
    With Selection
        .Clear
        .RowHeight = 15
    End With
    
    With Range("B:B")
        .ColumnWidth = 10.71
    End With
    
    With Range("A1")
        ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
            "Index!A1", TextToDisplay:="Index"
    End With
    
    Range("B2").Select
    Selection.Interior.ColorIndex = 6
    ActiveCell.Value = "Paste Here"
    Selection.HorizontalAlignment = xlCenter
    Selection.Font.Bold = True
    
    Application.ScreenUpdating = bln
   
End Sub
Actually, the whole sheet links to Index.

Hello,

I have to copy the background color of a cell to another cell in the same sheet. I have the following code but it doesn't work right because it shows another color then the one the original cell has
If Cells(LastRow, "C").Value = "Liquids" Then
   Cells(7, "O").Select
   index = Selection.Interior.ColorIndex
   Cells(LastRow, "B").Select
   Selection.Interior.ColorIndex = index
End If
Any suggestions? Thank you

Hi

I have been tinkering around trying to figure this out and to be quite honest got nowhere really.

I have code (recycled) in Access that loops through a query and generates a budget file for each person.

I would like to colour a range of cells based on the number of rows in the sheet, some people may have more clients than other. The cells have no data and the colouring is to lead people to which cells they need to enter data into.

The code I have so far is below, its a work in progress as I tidy up along the way, however this is the first part I have no idea on.

 Set ApXL = CreateObject("Excel.Application")

With ApXL
.Application.Visible = False
.UserControl = False
.Workbooks.Open strPath & strBrokerCode & " - FullIncomeRpt.xls"
              
' Formatting

    .Columns("A:A").ColumnWidth = 7.5
    .Columns("B:B").ColumnWidth = 33
    .Columns("C:G").Select
    .Selection.ColumnWidth = 12
    .Columns("C").NumberFormat = "#,##0.00_);[Red](#,##0.00)"
    .Columns("D").NumberFormat = "#,##0.00_);[Red](#,##0.00)"
    .Columns("E").NumberFormat = "#,##0.00_);[Red](#,##0.00)"
    .Columns("F").NumberFormat = "#,##0.00_);[Red](#,##0.00)"
    .Columns("G").NumberFormat = "#,##0.00_);[Red](#,##0.00)"
    .Range("I1").Formula = "Forecast Remainder 2010"
    .Range("J1").Formula = "Full Year Forecast 2010"
    .Range("L1").Formula = "Phasing Required"
    .Range("N1").Formula = "Budget 2011"
    .Range("P1").Formula = "Jan"
    .Range("Q1").Formula = "Feb"
    .Range("R1").Formula = "Mar"
    .Range("S1").Formula = "Apr"
    .Range("T1").Formula = "May"
    .Range("U1").Formula = "Jun"
    .Range("V1").Formula = "Jul"
    .Range("W1").Formula = "Aug"
    .Range("X1").Formula = "Sep"
    .Range("Y1").Formula = "Oct"
    .Range("Z1").Formula = "Nov"
    .Range("AA1").Formula = "Dec"
    .Range("AB1").Formula = "Err/Chk"
    .Rows("1:1").Select
    .Selection.WrapText = True
    .Selection.RowHeight = 50
    .Rows("2:4").Select
    .Selection.Insert shift:=xlDown
    .Selection.Interior.ColorIndex = xlNone
    .Selection.RowHeight = 15
    
    
    
    
    .Range("A1").Select
 
    
' Formula
Anything you can offer is appreciated.

Rob

Hi I really need help....with my listbox. I have a listbox that populates with specific rows from a worksheet behind it. The macro searches each row and puts the row in the listbox if it matches certain criteria, namely if column G is not empty and J > 0.

The listbox populates fine. It's what happens after which I can't get to work. I need the value entered into a textbox on the same userform as the listbox to be entered into a cell on the worksheet corresponding to the row selected in the listbox. This needs to be done after a command button is clicked on. At the moment I click on the button and it does nothing.

How do I do this?

Code for populating listbox:
Unload MainForm
Dim rng As Range, dn As Range, Ray, c As Long, Ac As Integer
Set rng = Range(Range("G6"), Range("G" & Rows.Count).End(xlUp))


ReDim Ray(1 To 12, 1 To rng.Count)
    For Each dn In rng
        If dn.Value <> "" And dn.Offset(, 3).Value > 0 Then
            c = c + 1
            For Ac = 0 To 11
                Ray(Ac + 1, c) = dn.Offset(, -6 + Ac)
            Next Ac
        End If
    Next dn
    ReDim Preserve Ray(1 To 12, 1 To c)
    Ray = Application.Transpose(Ray)

With UserForm.UserFormListBox
    .ColumnCount = 12
    .ColumnWidths = "20;35;70;120;0;55;55;55;50;40;45;200"
    .List = Ray
 End With
UsertForm.Show

Private Sub CommandButton1_Click()
Dim rng As Range, dn As Range
Dim n As Integer, Rw As String, Ac As Integer
Set rng = Range(Range("A5"), Range("A" & Rows.Count).End(xlUp))
With UserForm1.UserFormListBox
For n = 0 To .ListCount - 1
    If .Selected(n) Then
       For Ac = 0 To .ColumnCount - 1
            If IsDate(.Column(Ac, n)) Then
                Rw = Rw & CDbl(DateValue(.Column(Ac, n))) & ","
            Else
                Rw = Rw & UserFormListBox.Column(Ac, n) & ","
            End If
      Next Ac
      Exit For
    End If
 Next n
End With
If Rw <> "" Then
    Rw = Left(Rw, Len(Rw) - 1)
    For Each dn In rng
               If Rw = Join(Application.Transpose(Application.Transpose(dn.Resize(, 12))), ",") Then
           dn.Offset(1).EntireRow.Insert
           dn.Rows.Offset(1).EntireRow.Interior.ColorIndex = xlNone
           Range("E" & dn.Row + 1) = Textbox1.Value
           Range("D" & dn.Row + 1) = Textbox2.Value
           Range("I" & dn.Row + 1) = Textbox3.Value
           Range("H" & dn.Row + 1) = Date
        End If
Next dn
End If

End Sub


I need help.
I have a range of Cells F11-F510 that need to change color from green to white if data is entered into the cell.

Currently I can get my code to work for specifically F11...

It's located in a module and then is called in worksheet change

here's the code and it's pretty basic...

Sub CellValidation()

If Range("$F11:$F510").Value <> "" Then
Range("$F11:$F510").Select
With Selection.Interior
.ColorIndex = 2
End With
End If
End Sub


Hello

I'm having problems with the code below. It works a treat except when I add the Or's in the If statement. Can anyone tell me what I'm doing wrong?

Thanks

Sub SortRed()

box1.Hide

Workbooks.Open (MicSheet)

Dim ActCell As String

Range("A4").Select

Do While ActiveCell <> ""
ActCell = ActiveCell.Interior.ColorIndex

If ActCell <> 3 Or ActCell <> 18 Or ActCell <> 53 Then
ActiveCell.Offset(1, 0).Select
Else: MoveRow
End If

Loop

End Sub


I currently have pivot tables set up to different bar charts. Of course whenever information is updated in the pivot tables the bar charts revert back to the standard format. I setup a macro to reformat the charts how I want them when the pivot tables are updated.

The problem that I have is sometimes there are three legend entries in the chart I am reformatting and sometimes there are four. How could I make an 'If' statement to say "If there is a fourth legend entry, then reformat it. If there is not a fourth legend entry, then End Sub" Here is what it looks like now:

ActiveChart.Legend.LegendEntries(4).LegendKey.Select
    With Selection.Border
        .Weight = xlHairline
        .LineStyle = xlContinuous
    End With
    Selection.Shadow = False
    Selection.InvertIfNegative = False
    With Selection.Interior
        .ColorIndex = 37
        .Pattern = xlSolid
    End With
End Sub
Thank you for your help!

Hi,

Hope everyone is well.

How do i edit the below code that automatically sends an email the the specified address, i need to change it so that it allows me to write a message in the message body of the e-mail and then i will click send on the email manually?

Sub Mail_Range()
Application.Run "'Recall_Tracker-MPS.xlsm'!Unprotect"
    Dim Source As Range
    Dim Dest As Workbook
    Dim wb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    
'insertion
    CurCol = Selection.Interior.ColorIndex
    Selection.Interior.ColorIndex = 6
'end of insertion

    Set Source = Nothing
    On Error Resume Next
    Set Source = Range("A1:U36").SpecialCells(xlCellTypeVisible)
    On Error GoTo 0

    If Source Is Nothing Then
        MsgBox "The source is not a range or the sheet is protected, " & _
               "please correct and try again.", vbOKOnly
        Exit Sub
    End If

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Set wb = ActiveWorkbook
    Set Dest = Workbooks.Add(xlWBATWorksheet)

    Source.Copy
    With Dest.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial Paste:=xlPasteValues
        .Cells(1).PasteSpecial Paste:=xlPasteFormats
        .Cells(1).Select
        Application.CutCopyMode = False
    End With
    
'insertion
    wb.Activate
    Selection.Interior.ColorIndex = CurCol
'end of insertion
    
    TempFilePath = Environ$("temp") & ""
    TempFileName = "Selection of " & wb.Name & " " _
                 & Format(Now, "dd-mmm-yy h-mm-ss")

    If Val(Application.Version) < 12 Then
        'You use Excel 2000-2003
        FileExtStr = ".xls": FileFormatNum = -4143
    Else
        'You use Excel 2007
        FileExtStr = ".xlsx": FileFormatNum = 51
    End If

    With Dest
       .SaveAs TempFilePath & TempFileName & FileExtStr, _
                FileFormat:=FileFormatNum
        On Error Resume Next
        .SendMail "email address here", _
                  "subject line here"
        On Error GoTo 0
        .Close SaveChanges:=False
    End With

    Kill TempFilePath & TempFileName & FileExtStr

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
' colourchange Macro
'

'
    Range( _
        "B6:G22,G23:I23,L23:N23,Q23:S23,P6:Q22,K6:L22,E27:F29,E31:F31,E33:F33,C27:C28") _
        .Select
    Range("C27").Activate
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorLight2
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0
    End With
    Range("H6:J22,M6:O22,R6:T22,C26").Select
    Range("C26").Activate
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent5
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0
    End With
    Application.Run "'Recall_Tracker-MPS.xlsm'!Protect"
    Range("B2:D2").Select
End Sub
Basically i would like it to do all of the above but stop right at the point of sending so that i can write a message and then click send?

Regards,
Jamie

Hi,

I have some code which highlights an entire row depending upon which row is selected:

Private
Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Cells.Interior.ColorIndex = -4142
With Target.EntireRow.Interior
.ColorIndex = 6
End With
End Sub
This works nicely but has two problems.

1) It removes all current cell formatting - which i would like to keep

2) It highlights the entire row and not a range of cells (ie. A7:K1000)

Could anyone help me modify this?

Thanks

Hello!
I have this macro that I want to use on all files in a folder (*.csv). It can be up 100 files at the most and it is hard work doing manually. Is there a way to put this macro to be able to run on all files in a folder and at the best be saved as an excelfile (as I want to keep the formatting).

Original files are *csv files...

Sub JusteraRutter()
'
' Makro1 Makro
'

'
    Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 1), Array(9, 1)), TrailingMinusNumbers:=True
    Range("D1").Select
    Selection.End(xlDown).Select
    Selection.Copy
    ActiveCell.Offset(1, -1).Activate
    ActiveSheet.Paste
    
    Range("D3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("C2").Select
    Selection.End(xlDown).Select
    Selection.Cut
    ActiveCell.Offset(-1, 1).Activate
    ActiveSheet.Paste
    
    Columns("H:H").Select
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    
    Range("H2").Select
    ActiveCell.FormulaR1C1 = _
       
"=IF(ISERROR(FIND(""PLD"",RC[-2],1)),"""",MID(RC[-2],FIND(""PLD"",RC[-2],1)+4,5)*1)"
    Range("I2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(ISERROR(FIND(""PL Ej
Direkt"",RC[-3],1)),"""",MID(RC[-3],FIND(""PL Ej
Direkt"",RC[-3],1)+13,5)*1)"
    Range("J2").Select
    ActiveCell.FormulaR1C1 = _
       
"=IF(ISERROR(FIND(""FBX"",RC[-4],1)),"""",MID(RC[-4],FIND(""FBX"",RC[-4],1)+4,5)*1)"
    Range("K2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(ISERROR(FIND(""FFH
Gång"",RC[-5],1)),"""",MID(RC[-5],FIND(""FFH
Gång"",RC[-5],1)+9,5)*1)"
        Range("L2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(ISERROR(FIND(""FFH
Hiss"",RC[-6],1)),"""",MID(RC[-6],FIND(""FFH
Hiss"",RC[-6],1)+9,5)*1)"
        Range("M2").Select
    ActiveCell.FormulaR1C1 = _
       
"=IF(ISERROR(FIND(""Fritidshushåll"",RC[-7],1)),"""",MID(RC[-7],FIND(""Fritidshushåll"",RC[-7],1)+15,5)*1)"
        
    Range("H2:M2").Select
    Selection.Copy
    Range("G2").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(0, 1).Activate
    Range(Selection, Selection.End(xlUp)).Select
    ActiveSheet.Paste
        
    Range("H1").Select
    ActiveCell.FormulaR1C1 = " PLD "
    Range("I1").Select
    ActiveCell.FormulaR1C1 = " PL-Ej Dir "
    Range("J1").Select
    ActiveCell.FormulaR1C1 = " FBX "
    Range("K1").Select
    ActiveCell.FormulaR1C1 = " FFH-G "
    Range("L1").Select
    ActiveCell.FormulaR1C1 = " FFH-H "
    Range("M1").Select
    ActiveCell.FormulaR1C1 = " SPL "
    Range("H2").Select
    
    Rows("1:1").Select
    Selection.Insert Shift:=xlDow

    Range("A2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlUp)).Select
    Selection.Font.Bold = True
    With Selection.Interior
        .ColorIndex = 15
        .Pattern = xlSolid
    End With
    
    Range("D1:E1").Select
    With Selection
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "Antal stopp med:"
    
    Range("H1").Select
        ActiveCell.FormulaR1C1 = "=COUNT(R[2]C:R[500]C)"
    Range("I1").Select
    ActiveCell.FormulaR1C1 = "=COUNT(R[2]C:R[500]C)"
    Range("J1").Select
    ActiveCell.FormulaR1C1 = "=COUNT(R[2]C:R[500]C)"
    Range("K1").Select
    ActiveCell.FormulaR1C1 = "=COUNT(R[2]C:R[500]C)"
    Range("L1").Select
    ActiveCell.FormulaR1C1 = "=COUNT(R[2]C:R[500]C)"
    Range("M1").Select
    ActiveCell.FormulaR1C1 = "=COUNT(R[2]C:R[500]C)"
    Range("N1").Select
        
    Cells.Select
    Cells.EntireColumn.AutoFit
    
    Range("A:A,C:E,G:G,H:N").Select
    Range("H1").Activate
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Columns("G:M").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Columns("F:F").Select
    Selection.Cut
    Columns("P:P").Select
    ActiveSheet.Paste
    Columns("F:F").Select
    Selection.Delete Shift:=xlToLeft
    Range("A2").Select
    
    'Range("A2").Select
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$1:$2"
        .PrintTitleColumns = ""
    End With
    ActiveSheet.PageSetup.PrintArea = "$A:$M"
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.393700787401575)
        .RightMargin = Application.InchesToPoints(0.393700787401575)
        .TopMargin = Application.InchesToPoints(0.590551181102362)
        .BottomMargin = Application.InchesToPoints(0.393700787401575)
        .HeaderMargin = Application.InchesToPoints(0.511811023622047)
        .FooterMargin = Application.InchesToPoints(0.511811023622047)
        .PrintHeadings = False
        .PrintGridlines = True
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 100
        .PrintErrors = xlPrintErrorsDisplayed
    End With
End Sub


Hi,

I have have written some VBA code and attached it to a text box saying PRINT.

When the button is pressed a pop-up should come up saying Warning! Have you created a unique reference. This then has yes and no buttons. If the user clicks yes the sheet should print, if the user clicks no, the cell "I3" should be selected and highlighted yellow. I have got the code to work but it also turns the cell that was previously selected yellow, any help?

This is what I have so far:
Sub Macro4()
'

response = MsgBox("Have you created a unique reference?", vbYesNo, "Warning!")

If response = vbYes Then ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

If response = vbNo Then Range("i3").Select
Selection.Interior.ColorIndex = 6




End Sub
Thanks

Hi,

I have to codes which work
Sub consol_data()
    Dim ws As Worksheet
    Dim Rng As Range
    Dim LR

    Application.ScreenUpdating = False

    Sheet1.Range("A3:K3").Copy Destination:=Sheet17.Range("A3")

    LR = Sheets("Orders").Range("A" & Rows.Count).End(xlUp).Row + 1

    For Each ws In Worksheets
        If ws.Name <> "Summary" And ws.Name <> "Archive" And ws.Name <>
"Orders" And ws.Name <> "Blank" Then
            ws.UsedRange.Offset(4, 0).Copy Destination:=Sheets("Summary").Range("A" & LR)
        End If
        LR = Sheets("Summary").Range("A" & Rows.Count).End(xlUp).Row + 1
    Next ws
    Application.ScreenUpdating = True

End Sub
and

Sub PivotMacro()
Dim pt As PivotTable

    Set pt = ActiveSheet.PivotTables("MyPivot")

    pt.RefreshTable
End Sub
Is there any way I can add a line to the code so it selects all cells and changes the backdround colour to white and then I need no borders on cells A4:K100 but then a border round A3:K3

This will do it but I dont know how to include it in my other two:

Sub Format()

    Cells.Select
    Selection.Interior.ColorIndex = 2
    Range("A4:K100").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    
    Range("A3:K3").Select
    Range("K3").Activate
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
  
End Sub
I did the above using macro recorder

Hi
I work in a company that has altered the standard Excel color palette. Now one of my macros, which colours cells light yellow, does no longer produce the correct colour. I have tried to use RGB but could not work it out.
Any suggestions?

Sub FillYellow()
With Selection.Interior
.ColorIndex = 36
.Pattern = xlSolid
End With
End Sub


Hello, I have a spreadsheet that shows which month a vendor pays. I need each of these months to have a different color, for ease of reading. I have tried the CF, but I can only get three colors out of it.

I got this to work, but not how I want it. I would like to be able to auto color the cell when I leave that cell. The way it is now I have to go back and click the cell again. I have tried putting this code in 'SelectionChange' section of sheet1. I have put it everywhere I could think of, but it still does the same thing, I have to click back into the cell to give it color.

Is there any way to have it so that when I push enter, or tab out of the cell it will give color to the cell I just left.

If
ActiveCell = "Jan" Then
    With Selection.Interior
        .ColorIndex = 38
        .Pattern = xlSolid
    End With
    Else
    End If
If ActiveCell = "Jan-Feb" Then
    With Selection.Interior
        .ColorIndex = 38
        .Pattern = xlSolid
    End With
    Else
    End If
If ActiveCell = "Feb" Then
    With Selection.Interior
        .ColorIndex = 40
        .Pattern = xlSolid
    End With
    Else
    End If
If ActiveCell = "Feb-Mar" Then
    With Selection.Interior
        .ColorIndex = 40
        .Pattern = xlSolid
    End With
    Else
    End If
If ActiveCell = "Mar" Then
    With Selection.Interior
        .ColorIndex = 36
        .Pattern = xlSolid
    End With
    Else
    End If
If ActiveCell = "Mar-Apr" Then
    With Selection.Interior
        .ColorIndex = 36
        .Pattern = xlSolid
    End With
    Else
    End If
If ActiveCell = "Apr" Then
    With Selection.Interior
        .ColorIndex = 24
        .Pattern = xlSolid
    End With
    Else
    End If
If ActiveCell = "Apr-May" Then
    With Selection.Interior
        .ColorIndex = 24
        .Pattern = xlSolid
    End With
    Else
    End If
If ActiveCell = "May" Then
    With Selection.Interior
        .ColorIndex = 34
        .Pattern = xlSolid
    End With
    Else
    End If
If ActiveCell = "May-June" Then
    With Selection.Interior
        .ColorIndex = 34
        .Pattern = xlSolid
    End With
    Else
    End If
If ActiveCell = "June" Then
    With Selection.Interior
        .ColorIndex = 37
        .Pattern = xlSolid
    End With
    Else
    End If
If ActiveCell = "June-July" Then
    With Selection.Interior
        .ColorIndex = 37
        .Pattern = xlSolid
    End With
    Else
    End If
If ActiveCell = "July" Then
    With Selection.Interior
        .ColorIndex = 39
        .Pattern = xlSolid
    End With
    Else
    End If
If ActiveCell = "July-Aug" Then
    With Selection.Interior
        .ColorIndex = 39
        .Pattern = xlSolid
    End With
    Else
    End If
If ActiveCell = "Aug" Then
    With Selection.Interior
        .ColorIndex = 15
        .Pattern = xlSolid
    End With
    Else
    End If
If ActiveCell = "Aug-Sept" Then
    With Selection.Interior
        .ColorIndex = 15
        .Pattern = xlSolid
    End With
    Else
    End If
If ActiveCell = "Sept" Then
    With Selection.Interior
        .ColorIndex = 10
        .Pattern = xlSolid
    End With
    Else
    End If
If ActiveCell = "Sept-Oct" Then
    With Selection.Interior
        .ColorIndex = 10
        .Pattern = xlSolid
    End With
    Else
    End If
If ActiveCell = "Oct" Then
    With Selection.Interior
        .ColorIndex = 33
        .Pattern = xlSolid
    End With
    Else
    End If
If ActiveCell = "Oct-Nov" Then
    With Selection.Interior
        .ColorIndex = 33
        .Pattern = xlSolid
    End With
    Else
    End If
If ActiveCell = "Nov" Then
    With Selection.Interior
        .ColorIndex = 8
        .Pattern = xlSolid
    End With
    Else
    End If
If ActiveCell = "Nov-Dec" Then
    With Selection.Interior
        .ColorIndex = 8
        .Pattern = xlSolid
    End With
    Else
    End If
If ActiveCell = "Dec" Then
    With Selection.Interior
        .ColorIndex = 4
        .Pattern = xlSolid
    End With
    Else
    End If
If ActiveCell = "Dec-Jan" Then
    With Selection.Interior
        .ColorIndex = 4
        .Pattern = xlSolid
    End With
    Else
    End If
If ActiveCell = "0" Then
    Selection.Interior.ColorIndex = xlNone
    Else
    End If
If ActiveCell = "" Then
    Selection.Interior.ColorIndex = xlNone
    Else
    End If


Hi everyone,

The VBA code (in the code window) runs nicely on the range B10:B1000, but I'd prefer that it only run on a range I define by the cells that are currently highlighted/selected on the active sheet. How should the line of code:

Set SHOPS = Range("B10:B1000")

be changed to accomplish this?

Sub SetShopColors()
'Format cell colors based on shop number (text) as cell value
Dim SHOPS As Range, cell As Range
Set SHOPS = Range("B10:B1000")    'How do I change this to set the range as the currently highlighted cells on the
sheet?

For Each cell In SHOPS
    Select Case cell.Value
        Case "110", "111", "112", "112A", "112B", "113",
"114", "114A"
            cell.Interior.ColorIndex = 44   'Gold
        Case "120", "121", "122", "122A", "122B", "123",
"123A", "124", "124A", "124B", "124C", "124D", "124E",
"125"
            cell.Interior.ColorIndex = 40   'Tan
        Case "130", "132", "132A", "132B", "133", "135",
"136", "137", "137A", "137B"
            cell.Interior.ColorIndex = 35   'Light Green
        Case "140", "140B", "140C", "141", "141A", "142",
"143", "143A"
            cell.Interior.ColorIndex = 50   'Sea Green
        Case "150", "151", "152", "152A", "152B", "153",
"153A", "153B", "153C", "154", "154A", "154B", "154C",
"154D"
            cell.Interior.ColorIndex = 37   'Pale Blue
        Case "160", "161", "161A", "161B", "162", "162A",
"162B", "162C", "163", "164", "164A"
            cell.Interior.ColorIndex = 3   'Red
        Case "180", "181", "182", "183", "184"
            cell.Interior.ColorIndex = 6   'Yellow
        Case Else
            cell.Interior.ColorIndex = xlNone  'Clear
    End Select
Next cell

End Sub
Cheers,

Hi I am trying to build a macro which will format the columns of a spreadsheet - basically it inserts some columns, writes formulas and highlights them. Here is a code I have got so far...

When I try to run this I get a run time error 1004 - Method 'Range' of 'Object'_Global' failed. The part of the code
Range("N2:N").FormulaR1C1 = "=(RC[-7]/RC[-2])"

is highlighted in the debugger.

Can anyone tell me why this is happening, also it would be great if you could suggest better ways of writing this code - as I am new to vba programming and most of my macros are built using the recorder and then 'working' on them.

Thanks.

Sub formatcolumns()

    Columns("G:G").Insert Shift:=xlToRight
    Range("H1").Select
    Selection.Copy
    Range("G1").Select
    ActiveSheet.Paste
    Columns("N:N").Select
    Application.CutCopyMode = False
    Selection.Insert Shift:=xlToRight
    Range("N1").FormulaR1C1 = "=(RC[-1])"
    Range("N2:N").FormulaR1C1 = "=(RC[-7]/RC[-2])"
    Columns("N:N").Interior.ColorIndex = 36
    Columns("R:R").Insert Shift:=xlToRight
    Range("R1").FormulaR1C1 = "=(RC[-1])"
    Range("R2:R").FormulaR1C1 = "=(RC[-4]/RC[-2])"
    Columns("R:R").Interior.ColorIndex = 36
    Columns("U:U").Insert Shift:=xlToRight
    Range("U1").FormulaR1C1 = "=(RC[-1])"
    Range("U2:U").FormulaR1C1 = "=(RC[-14]*RC[-2])"
    Columns("U:U").Interior.ColorIndex = 36
    Columns("AC:AC").Insert Shift:=xlToRight
    Range("AC1").FormulaR1C1 = "=(RC[-1])"
    Range("AC2:AC").FormulaR1C1 = "=(RC[-5]+RC[-4]+RC[5]+RC[-22])/(RC[1]+RC[2])"
    Columns("AC:AC").Interior.ColorIndex = 15
    Columns("AJ:AJ").Interior.ColorIndex = 35
    Columns("AN:AN").Insert Shift:=xlToRight
    Range("AN1").FormulaR1C1 = "=(RC[-1])"
    Range("AN2:AN").FormulaR1C1 = "=(RC[-4]-RC[-33])"
    Columns("AN:AN").Interior.ColorIndex = 35
    Columns("AR:AR").Insert Shift:=xlToRight
    Range("AR1").FormulaR1C1 = "=(RC[-1])"
    Range("AR2:AR").FormulaR1C1 = "=(RC[-4]/RC[-3])"
    Columns("AR:AR").Interior.ColorIndex = 35
    Columns("BB:BD").Select
    Selection.Cut
    Columns("L:L").Insert Shift:=xlToRight
    Columns("M:N").Select
    Selection.Cut
    Columns("R:R").Insert Shift:=xlToRight
    Columns("J:J").Select
    Selection.Cut
    Columns("D:D").Insert Shift:=xlToRight
    Range("N2").Select
    Selection.AutoFilter
    ActiveWindow.FreezePanes = True
    Columns("AG:AG").Select
    Selection.Interior.ColorIndex = 34
    Columns("AH:AH").Select
    Selection.Interior.ColorIndex = 33
End Sub



No luck finding an answer? You could always try Google.