VBA Error 1004 Object Range failed for _Global - vba

I need to make a little VBA Application for a School project.
I recorded a Macro which Resize all Cells and then make them green. After that I select specific Cells and recolor them in white. So the result should be the Excel logo. However when I run the code there is an Error 1004 Range Object failed for _Global.
Code:
Sub Resize()
Columns("A:BZ").ColumnWidth = 2.71
Rows("1:1000").RowHeight = 15
Cells.Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 4485149
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Union(Range( _
"O14:P15,L7:T7,S5:T6,P6:Q6,E38:F47,G46:J47,G42:J43,G38:J39,N38:O39,O40:R41,R38:S39,P42:Q43,O44:R45,N46:O47,R46:S47,W38:X47,Y46:AB47,Y38:AB39,AF38:AK39,AF40:AG47,AH46:AK47,AH42:AK43,AO38:AP47,AQ46:AT47,R6,Y7:AP9,AN10:AP31,Y29:AM31,AF10:AF28,AG24:AM24,Y24:AE24" _
), Range( _
"AG19:AM19,AG14:AM14,Y14:AE14,V4:X33,U5:U32,T12:T25,S14:S23,R16:R21,Q18:Q19,Q28:T32,M26:R27,N24:Q25,O22:P23,L28:P31,H28:K30,F9:G29,H8:J27,K12:K25,L14:L23,M16:M21,N18:N19,K8:T9,M10:R11,N12:Q13" _
)).Select
Cells.Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End Sub

the string fed to Range must be less then 256 characters, while your first range has just 257... so just shift some characters to the 2nd range
furthermore you're selecting all cells instead of wanted ones
see code:
Option Explicit
Sub Resize()
With Range("A1:BZ1000")
.ColumnWidth = 2.71
.RowHeight = 15
With .Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 4485149
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End With
With Union(Range( _
"O14:P15,L7:T7,S5:T6,P6:Q6,E38:F47,G46:J47,G42:J43,G38:J39,N38:O39,O40:R41,R38:S39,P42:Q43,O44:R45,N46:O47,R46:S47,W38:X47,Y46:AB47,Y38:AB39,AF38:AK39,AF40:AG47,AH46:AK47,AH42:AK43,AO38:AP47,AQ46:AT47,R6,Y7:AP9,AN10:AP31,Y29:AM31" _
), Range( _
"AF10:AF28,AG24:AM24,Y24:AE24,AG19:AM19,AG14:AM14,Y14:AE14,V4:X33,U5:U32,T12:T25,S14:S23,R16:R21,Q18:Q19,Q28:T32,M26:R27,N24:Q25,O22:P23,L28:P31,H28:K30,F9:G29,H8:J27,K12:K25,L14:L23,M16:M21,N18:N19,K8:T9,M10:R11,N12:Q13" _
)).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End Sub

Related

Excel/ how to connect buttons on different worksheets

my first button (Schaltfläche 83)
Other button which I want to activate vom "Hirata Bestellformular"
1st option: the top blue one
2nd option: the big one (activexelement)
I want to activate one button from another worksheet because I want to execute the code below on the worksheet "Teileliste" directly from "Hirata Bestellformular". How can I accomplish this?
Sub Teileliste_generieren()
' advanced filter
Sheets("Hirata Bestellformular").Range("Tabelle3[[#Headers],[#Data]]"). _
AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range("B50:B51"), _
CopyToRange:=Range("B54:B55"), Unique:=False
Range("B5").Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(LEFT(R[50]C,FIND(CHAR(10),R[50]C)-1),R[50]C)"
Range("B6").Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(LEFT(R[50]C,FIND(CHAR(10),R[50]C)-1),R[50]C)"
Range("B5:B6").Select
Selection.AutoFill Destination:=Range("B5:B26"), Type:=xlFillDefault
Range("B5:B26").Select
Range("D22").Select
'formatierung tabelle
Range("B3").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 16763955
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("B4").Select
With Selection.Interior
.Pattern = xlSolid
.PatternThemeColor = xlThemeColorAccent3
.Color = 16777215
.TintAndShade = 0
.PatternTintAndShade = 0.799981688894314
End With
Range("B5").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 9868950
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("B6").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 15395562
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("B5:B6").Select
Selection.AutoFill Destination:=Range("B5:B26"), Type:=xlFillDefault
Range("B5:B26").Select
Range("D20").Select
' Wenn 0 blank
Range("B5:B26").Select
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="=0"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Range("C22").Select
' Exportieren
ThisWorkbook.Sheets("Teileliste").Copy
Application.GetSaveAsFilename
End Sub
I can try. :)
If I understand you, you want to be able to press Teileliste generieren from Hirata Bestellformular. This means that you still want the button Schaltfläche 83 do to the same thing as Teileliste generieren, but you don't want to switch sheets to press the button?
Then I believe your problem is in your Range.Select statements.
In Excels VBA Object Model, if you call Range("B50:B51").Select from the Teileliste-sheet, then it will automatically select that range in Teileliste-sheet. If do it from Hirata Bestellformular, then it will select Range("B50:B51") from Hirata Bestellformular instead.
This means: it should work if you change all your Range("...").Select to Worksheets("Teileliste").Range("...").Select
This has to do with the Excel VBA Object Model.
I'm pretty sure that should do the trick but it depends on where your code is placed (within the specific sheets or in a Module). Try replacing the Range.Selects and see if it helps. :)
Just A quick hint:
You can right-click the button Schaltfläche 83 and assign a macro to it. So in your case you can just right-click -> assign macro -> choose
Teileliste_generieren()
If your code can deal with being called on different sheets, then it Will work.
//from My iPhone
Sub Teileliste_generieren2()
' advanced filter
Sheets("Hirata Bestellformular").Range("Tabelle3[[#Headers],[#Data]]"). _
AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Worksheets("Teileliste").Range("B50:B51"), _
CopyToRange:=Worksheets("Teileliste").Range("B54:B55"), Unique:=False
Worksheets("Teileliste").Range("B5").Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(LEFT(R[50]C,FIND(CHAR(10),R[50]C)-1),R[50]C)"
Worksheets("Teileliste").Range("B6").Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(LEFT(R[50]C,FIND(CHAR(10),R[50]C)-1),R[50]C)"
Worksheets("Teileliste").Range("B5:B6").Select
Selection.AutoFill Destination:=Worksheets("Teileliste").Range("B5:B26"), Type:=xlFillDefault
Worksheets("Teileliste").Range("B5:B26").Select
Worksheets("Teileliste").Range("D22").Select
'formatierung tabelle
Worksheets("Teileliste").Range("B5").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark2
.TintAndShade = -0.249977111117893
.PatternTintAndShade = 0
End With
Worksheets("Teileliste").Range("B6").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent4
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
Worksheets("Teileliste").Range("B5:B6").Select
Selection.AutoFill Destination:=Worksheets("Teileliste").Range("B5:B26"), Type:=xlFillDefault
Worksheets("Teileliste").Range("B5:B26").Select
Worksheets("Teileliste").Range("C18").Select
' Wenn 0 blank
Worksheets("Teileliste").Range("B5:B26").Select
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="=0"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Worksheets("Teileliste").Range("C22").Select
' Exportieren
ThisWorkbook.Sheets("Teileliste").Copy
Application.GetSaveAsFilename
End Sub
I just replaced it everywhere like you said and it works if I aktivate the makro from "Teileliste" but there s error when I acctivate it from "Hiraa Bestellformular" saying: Error1004 he Select- Method of the Range-Object could not be executed:/ Another suggestion?:)

Formatting specific set of cells on all sheets

The code below doesn't give any error, but it isn't doing exactly what I want it to do, and I'm not sure what I'm doing wrong.
The purpose of the code is to add a formulae into specific cells in all the sheets based on a criteria on each sheet. This part of the formulae is working perfectly fine (if it can be made shorter, then that would be a bonus). The part that isn't working properly is the formatting section of the code. I want the defined formatting to occur on all the sheets, but its only happening on the first "Summary" sheet.
As I mentioned earlier there is no error messages, it runs through fine, but only changing the formatting of the cells in the Summary sheet and not on all the sheets.
Any advice would be much appreciated:)
Sub Summary()
Dim wb1 As Workbook
Dim Sht As Worksheet
Dim Rng, Rng2 As Range
Dim cell As Range
Dim ws As Worksheet
Set wb1 = ThisWorkbook
Set Sht = wb1.Worksheets("Summary")
Set Rng = Sht.Range("A6:A" & Sht.Cells(Sht.Rows.Count, "A").End(xlUp).Row)
For Each cell In Rng
Set ws = wb1.Sheets(cell.Text)
Select Case ws.Range("A4").Value
Case "Standard Kitchen Template"
ws.Range("G10").Formula = "=Sum(e2167:e2182, e2179:e2885)"
ws.Range("H10").Formula = "=Sum(e49:e54, e291:e296)"
ws.Range("I10").Formula = "=Sum(e125:e139)"
ws.Range("J10").Formula = "=Sum(e213:e286, e299:e302)"
ws.Range("K10").Formula = "=Sum(e168:e208)"
ws.Range("L10").Formula = "=Sum(e156:e162)"
ws.Range("O10").Formula = "=Sum(e142:e148)"
ws.Range("Q10").Formula = "=Sum(e14:e48, e56:e78)"
Case "Standard Bathroom Template"
ws.Range("G10").Formula = "=Sum(e334:e339, e347:e1050)"
ws.Range("H10").Formula = "=Sum(e185:e317)"
ws.Range("I10").Formula = "=Sum(e79:e97)"
ws.Range("J10").Formula = "=Sum(e68:e70, e323:e326)"
ws.Range("K10").Formula = "=Sum(e134:e178)"
ws.Range("L10").Formula = "=Sum(e115:e132)"
ws.Range("O10").Formula = "=Sum(e99:e107)"
ws.Range("Q10").Formula = "=Sum(e29:e33, e41:e50)"
End Select
Next cell '<------The code below this line is the one not working properly
For Each Sht In ThisWorkbook.Sheets
With Sht
Range("G10").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 12611584
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("H10").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("I10").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 49407
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("J10").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("K10").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 5296274
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("L10").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 10498160
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("O10").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent3
.TintAndShade = -0.249977111117893
.PatternTintAndShade = 0
End With
Range("Q10").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
End With
Next
End Sub
In your For Each Sht In ThisWorkbook.Sheets loop you are not using the Sht object. You are referring to the ranges within your ActiveSheet because your .Select methods are not prefixed with a . which connects the ranges to your Sht object.
For example after your With Sht you need your next line to be .Range("G10").Select not Range("G10").Select - notice the . at the beginning.
You have also already used the variable of Sht earlier in your code to define wb1.Worksheets("Summary") so it would be best to use a different variable in your loop to avoid confusion.
However, it is always advised not to use Select as this slows down code. Try this instead:
For Each Sht In ThisWorkbook.Sheets
With Sht
With .Range("G10").Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 12611584
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With .Range("H10").Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With .Range("I10").Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 49407
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With .Range("J10").Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With .Range("K10").Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 5296274
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With .Range("L10").Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 10498160
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With .Range("O10").Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent3
.TintAndShade = -0.249977111117893
.PatternTintAndShade = 0
End With
With .Range("Q10").Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
End With
Next Sht

VBA RGB colour specification of cell

I would like to change the cell colour with RGB: 212, 231, 237 and i record macro as follow:
Sub Macro2()
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 15591380
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End Sub
I wonder how .Color = 15591380
Thanks
The Code for RGB is just this ;)
Sub Macro2()
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = RGB(212, 231, 237)
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End Sub

How to conditional format data in multiple columns by hardcoding what the column's header name is?

I'm looking to run a series of conditional formatting rules on two columns of data. I know I can select a column letter and all the cells in that columns, but to make my macro more full-proof I'd like for it to search for the column's header and run the formatting on the cells below the two specific headers.
I Currently used the Record Macro tool to see how this could potentially work, and this is my current setup. This macro does work, I would just like to make it full-proof and search through the worksheet for the specific column title names. I'd like to search a woorksheet for the column Titles "Header 1" and "Header 2".
Sub TwoColumnConditional()
Columns("K:AJ").Select
Selection.FormatConditions.Add Type:=xlTextString, String:="CONTAINSTEXT1", _
TextOperator:=xlContains
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.Color = -16383844
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 13551615
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Selection.FormatConditions.Add Type:=xlTextString, String:="CONTAINSTEXT2", _
TextOperator:=xlContains
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.Color = -16751204
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 10284031
.TintAndShade = 0
End With
End Sub
Try this:
Sub ApplyCF()
Dim ws As Worksheet
Dim rng As Range, fcel As Range, hrng As Range
Dim myheaders, header
Dim mycondition As String
myheaders = Array("Header 1", "Header 2")
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
Set rng = .Range("A1", .Range("A1").Offset(0 _
, .Columns.Count - 1).End(xlToLeft).Address)
'Debug.Print headers.Address
End With
For Each header In myheaders
Set fcel = rng.Find(header, rng.Cells(rng.Cells.Count))
If Not fcel Is Nothing Then
If hrng Is Nothing Then
Set hrng = fcel.EntireColumn
Else
Set hrng = Union(hrng, fcel.EntireColumn)
End If
End If
Next
'Debug.Print hrng.address
hrng.FormatConditions.Add Type:=xlTextString, String:="CONTAINSTEXT1", _
TextOperator:=xlContains
With hrng.FormatConditions(hrng.FormatConditions.Count)
With .Font
.Color = -16383844
.TintAndShade = 0
End With
With .Interior
.PatternColorIndex = xlAutomatic
.Color = 13551615
.TintAndShade = 0
End With
.StopIfTrue = False
End With
hrng.FormatConditions.Add Type:=xlTextString, String:="CONTAINSTEXT2", _
TextOperator:=xlContains
With hrng.FormatConditions(hrng.FormatConditions.Count)
With .Font
.Color = -16751204
.TintAndShade = 0
End With
With .Interior
.PatternColorIndex = xlAutomatic
.Color = 10284031
.TintAndShade = 0
End With
.StopIfTrue = False
End With
End Sub
I only assumed your headers are in the first row.
Adjust the code to suit.

Subroutine to format cells

I am trying to format cells in excel
Following is the code I have:
Range("A1:F1").Select
Selection.Font.Bold = True
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
I need to repeat the formatting steps multiple times for different ranges, can I call a subroutine instead?
Here is one way to apply the format to a number of ranges in a loop:
Sub dural()
Dim r As Range
ary = Array(Range("A1:Z1"), Range("A3:Z3"), Range("A7:Z7"))
For i = LBound(ary) To UBound(ary)
Call FFormat(ary(i))
Next
End Sub
Sub FFormat(rIn As Variant)
rIn.Font.Bold = True
With rIn.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End Sub