Formating a cell based on another cell conditional formatting [closed] - excel

Closed. This question is not reproducible or was caused by typos. It is not currently accepting answers.
This question was caused by a typo or a problem that can no longer be reproduced. While similar questions may be on-topic here, this one was resolved in a way less likely to help future readers.
Closed 4 days ago.
Improve this question
I have a table that has a column formated using a "Graded Colour Scale" conditional format
I am trying to format the other cells in the same row of this table based on this column using vba:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("A1:G40")) Is Nothing Then
Dim cc As Long
For cc = 11 To 40
Me.Range("D" & cc).Interior.Colour = Me.Range("E" & cc).DisplayFormat.Interior.Color
Me.Range("B" & cc).Interior.Colour = Me.Range("E" & cc).DisplayFormat.Interior.Color
Me.Range("C" & cc).Interior.Colour = Me.Range("E" & cc).DisplayFormat.Interior.Color
Next
End If
End Sub
I tried as well with
Me.Range("D" & cc).Interior.Colour = Me.Range("E" & cc).Interior.Color
Me.Range("B" & cc).Interior.Colour = Me.Range("E" & cc).Interior.Color
Me.Range("C" & cc).Interior.Colour = Me.Range("E" & cc).Interior.Color
Both these codes get me
Run time error 438
Object doesn't support this property or method.
Thanks for your help.

Thank you too #ScottCraner, it was a typo.
For cc = 11 To 40
Me.Range("D" & cc).Interior.Color = Me.Range("E" & cc).DisplayFormat.Interior.Color
Me.Range("B" & cc).Interior.Color = Me.Range("E" & cc).DisplayFormat.Interior.Color
Me.Range("C" & cc).Interior.Color = Me.Range("E" & cc).DisplayFormat.Interior.Color
Next

Related

Send Reminder through Outlook

Good day all,
i am looking to alter the below VBA Code to send reminder to filtered range to each User based on specific text in column "H" "Send Reminder" and filtered range must be pasted into email below the body lines (Means Column A1:E1 by User wise filtered range).
Basically VBA code will reduce our work from more than hours to Milli seconds.
Problems encountered:
in our daily work we have so many todo list which needs to remind employee by employee wise with filtered list to each person will consume more than 2 hours to sort our data. Now the below code works but not filtered by User wise so its completely insufficient to use it properly. sending each email wise but filtered table also needs to place in the body of the emails is worthy. Hence time does not reduce much more than that.
Hence i am Looking to alter the below code as per my requirement.
Existing VBA Code:
Sub Send_Reminder()
Dim wStat As Range, i As Long
Dim dam As Object
For Each wStat In Range("H2", Range("H" & Rows.Count).End(xlUp))
If wStat.Value = "Send Reminder" Then
i = wStat.Row
Set dam = CreateObject("Outlook.Application").CreateItem(0)
dam.To = Range("I" & i).Value
dam.Cc = "" 'Range("F" & i).Value
dam.Subject = Range("B" & i).Value
dam.Body = "Hi " & Range("E" & i).Value & "," & vbCr & vbCr & _
"This is to remind you that " & Range("B" & wStat.Row).Value & " " & _
"Report is due today." & vbCr & vbCr & _
"Cheers!"
dam.FlagRequest = "Follow up" ' We set the Follow up Flag
dam.FlagDueBy = Format(DateAdd("d", 1, Date) + TimeValue("09:30:00"), "dd/mm/yyyy hh:mm") ' We set the due date for the reminder two days from today
dam.Display '.Sent
'
dam.Display '.Send
wStat.Value = "Sent"
End If
Next
MsgBox "Emails Sent"
End Sub

Adding Textbox value into concatenated formula

I was hoping you could help me with a coding issue. I have quite a long concatenated formula that is generated via a userform in VBA. The only problem that I have with it is the Textbox6. The value entered by the user should be only 1 or 0 (that’s not the issue). The issue is when the formula is generated, the result relating to Textbox6 is “1=1” or “0=0” followed the rest of the formula. I would like the formula to identify if the Textbox6 has either a 1 or 0 and then apply the condition assigned to that value (something like: Textbox6.Value = 1 Then …). I just can’t seem to get this to work. Any help would be much appreciated.
Thanks.
ActiveCell.Formula = "=""BOX ""&IF(OR(Base_Point=1,Base_Point=2,Base_Point=3,Base_Point=4),X_Origin+" & TextBox1 & ",X_Origin-" & TextBox1 & ")&"",""&IF(OR(Base_Point=3,Base_Point=4,Base_Point=5,Base_Point=6),Y_Origin-" & TextBox2 & ",Y_Origin+" & TextBox2 & ")& "",""&IF(" & TextBox6 & "=1,Z_End,Z_Origin)&"" ""&IF(OR(Base_Point=1,Base_Point=2,Base_Point=3,Base_Point=4),X_Origin+" & TextBox3 & ",X_Origin-" & TextBox3 & ")&"",""&IF(OR(Base_Point=3,Base_Point=4,Base_Point=5,Base_Point=6),Y_Origin-" & TextBox4 & ",Y_Origin+" & TextBox4 & ")&"",""&IF(AND(" & TextBox6 & "=1,OR(Base_Point=1,Base_Point=3,Base_Point=5,Base_Point=7)),Z_End-" & TextBox5 & ",IF(AND(" & TextBox6 & "=0,OR(Base_Point=1,Base_Point=3,Base_Point=5,Base_Point=7)),Z_Origin+" & TextBox5 & ",IF(AND(" & TextBox6 & "=1,OR(Base_Point=2,Base_Point=4,Base_Point=6,Base_Point=8)),Z_End+" & TextBox5 & ",IF(AND(" & TextBox6 & "=0,OR(Base_Point=2,Base_Point=4,Base_Point=6,Base_Point=8)),Z_Origin-" & TextBox5 & "))))"
According to you comment, does this solution work for you (just replace the TextBox6 related part of your code)?
IIf(TextBox6.Value = 1, "1", "0")
You can also evaluate the "0" scenario using nested IIf function:
IIf(TextBox6.Value = 1, "1", IIf(TextBox6.Value = 0, "0", "NOT_ALLOWED_VALUE"))
How to use IIf function

Is there a way to write this Excel Formula in VBA? [closed]

Closed. This question needs to be more focused. It is not currently accepting answers.
Want to improve this question? Update the question so it focuses on one problem only by editing this post.
Closed 2 years ago.
Improve this question
Is there a way to write this Excel Formula in VBA?
=SUM(
NUMBERVALUE(COUNTIF(SheetName!A:B,CONCATENATE((E3+1),(F3+1),G3,H3,I3,J3,$L$2))),
NUMBERVALUE((COUNTIF(SheetName!A:B,CONCATENATE((E3+1),F3,G3,H3,I3,J3,$L$2))))+
NUMBERVALUE((COUNTIF(SheetName!A:B,CONCATENATE((E3+1),(F3-1),G3,H3,I3,J3,$L$2))))+
NUMBERVALUE((COUNTIF(SheetName!A:B,CONCATENATE(E3,(F3+1),G3,H3,I3,J3,$L$2))))+
NUMBERVALUE((COUNTIF(SheetName!A:B,CONCATENATE(E3,F3,G3,H3,I3,J3,$L$2))))+
NUMBERVALUE((COUNTIF(SheetName!A:B,CONCATENATE(E3,(F3-1),G3,H3,I3,J3,$L$2))))+
NUMBERVALUE((COUNTIF(SheetName!A:B,CONCATENATE((E3-1),(F3+1),G3,H3,I3,J3,$L$2))))+
NUMBERVALUE((COUNTIF(SheetName!A:B,CONCATENATE((E3-1),F3,G3,H3,I3,J3,$L$2))))+
NUMBERVALUE((COUNTIF(SheetName!A:B,CONCATENATE((E3-1),(F3-1),G3,H3,I3,J3,$L$2)))))
please, is there a way I can write this formular in Excel VBA?
It concatenates cell values. e.g
X=cella1, X=cellb1 X=cellc1 + etc... and gives all possible combinations of these values X as Strings
The Countiffunction goes to a different excel sheet in that workbook, and selects a range and then counts the cells in that range, that meets the Strings condition, which is given to it as its second argument.
NumberValue then converts the strings to Integers.
Lastly it takes the sum of these Integers.
Try this code, please:
Dim sh As Worksheet, sh2 As Worksheet
Set sh = ActiveSheet
Set sh2 = Worksheets("SheetName") 'use here your real worksheet name
'Adapt here the cell where to formula to be dropped:
sh.Range("L3:L945").formula = "=SUM(NUMBERVALUE(COUNTIF(" & sh2.Name & "!A:B,CONCATENATE((E3+1)," & _
"(F3+1),G3,H3,I3,J3,$L$2))),NUMBERVALUE((COUNTIF(" & sh2.Name & "!A:B,CONCATENATE((E3+1)," & _
"F3,G3,H3,I3,J3,$L$2))))+NUMBERVALUE((COUNTIF(" & sh2.Name & "!A:B,CONCATENATE((E3+1),(F3-1)," & _
"G3,H3,I3,J3,$L$2))))+NUMBERVALUE((COUNTIF(" & sh2.Name & "!A:B,CONCATENATE(E3,(F3+1),G3,H3," & _
"I3,J3,$L$2))))+NUMBERVALUE((COUNTIF(" & sh2.Name & "!A:B,CONCATENATE(E3,F3,G3,H3,I3,J3,$L$2))))" & _
"+NUMBERVALUE((COUNTIF(" & sh2.Name & "!A:B,CONCATENATE(E3,(F3-1),G3,H3,I3,J3,$L$2))))+NUMBERVALUE" & _
"((COUNTIF(" & sh2.Name & "!A:B,CONCATENATE((E3-1),(F3+1),G3,H3,I3,J3,$L$2))))+NUMBERVALUE" & _
"((COUNTIF(" & sh2.Name & "!A:B,CONCATENATE((E3-1),F3,G3,H3,I3,J3,$L$2))))+NUMBERVALUE" & _
"((COUNTIF(" & sh2.Name & "!A:B,CONCATENATE((E3-1),(F3-1),G3,H3,I3,J3,$L$2)))))"

Macro VBA Excel sum by Group [closed]

Closed. This question needs to be more focused. It is not currently accepting answers.
Want to improve this question? Update the question so it focuses on one problem only by editing this post.
Closed 3 years ago.
Improve this question
I know in Excel we can use pivot table, but I just want to make a button to sum a group by Vendor, this is the illustrate of my table in Excel:
I just want to sum Amount grouping by Vendor in new column and add 1 column to proof that column has a value bigger than 2,550,000.
Like this result when I hit a button "RUN":
I need using macro because we have dynamic data from pivot table (SSAS) and always change everyday, so I have to make sure the new column in this excel to provide the data
Following formula can be used to sum the D column group by A column.
=IF(A2=A1,"",SUMIF(A:A,A2,D:D))
Then you can put the condition in F column.
=IF(ISNUMBER(D2),IF(D2>255000,TRUE,FALSE),"")
And you can use the following VBA code to write the above formula:
Private Sub Test()
Dim i As Integer
Dim Condition As Variant
Dim AVal As Variant
For i = 1 To 10 'replace 10 with last row count
Condition = "A" & i & "=A" & i - 1
AVal = "A" & i
Worksheets("Sheet1").Range("E" & i).Formula = "=IF(" & Condition & ","""",SUMIF(A:A," & AVal & ",D:D))"
DVal = "D" & i
Worksheets("Sheet1").Range("F" & i).Formula = "=IF(ISNUMBER(" & DVal & "),IF(" & DVal & ">255000,TRUE,FALSE),"""")"
Next i
End Sub

Remove duplicates excel vba [closed]

Closed. This question needs debugging details. It is not currently accepting answers.
Edit the question to include desired behavior, a specific problem or error, and the shortest code necessary to reproduce the problem. This will help others answer the question.
Closed 6 years ago.
Improve this question
I tried to remove duplicates using below code. But I am not getting desired output. Along with duplicate data other data are also get removed.
Sub account()
Dim d As String
Call Pvt_Account(192, 8)
End Sub
Sub Pvt_Account(RowNumber As Integer,sheetnumber As Integer)
Worksheets(sheetnumber).Activate
NumRows = Range("A1", Range("A1").End(xlDown)).Rows.Count
m = RowNumber
CellNumber = 2
For i = 1 To NumRows - 1
Sheet2.Range("C" & RowNumber) = Application.WorksheetFunction.CountIf(Range("F2:F" & NumRows), Cells(CellNumber, 6))
Sheet2.Range("b" & RowNumber) = Worksheets(sheetnumber).Range("f" & CellNumber)
RowNumber = RowNumber + 1
CellNumber = CellNumber + 1
Next i
Worksheets(2).Activate
r = (m + NumRows) - 2
Range("B" & m & " :C " & r).RemoveDuplicates Columns:=Array(2), Header:=xlYes
End Sub
In
Range("B" & m & " :C " & r).RemoveDuplicates Columns:=Array(2), Header:=xlYes
, I think you will want Columns:=Array(1) instead, i.e. removing duplicates from the first column of the range Bm:Cr, which is B. The space after :C should also be removed.

Resources