Posts by Paulod

Thanks heaps Carim, it's working a treat now. I appreciate the time you've sent helping me with this.:thanx:

By "Use the SUM of columns B and C instead of the PRODUCT" I mean that the original function on the heat map sheets uses the values in each row for columns B and C and multiplies them together, the resulting value determines which cell of the heat map the value of cell A is placed. I'm wanting the values in B and C to be added together instead of being multiplied and the value in cell A put in corresponding cell of the heat map.

Here's the file

Hi. My plea for help is explained in the 1st tab of the attachment, I hope it all makes sense. :thanx:

Hi Carim. I am referring to the video you linked. Tomorrow morning I’ll attach a file with what I’m trying to achieve. Cheers

There are plenty of posts asking for help with this common code and I have made it work for its intended purpose of multiplying the values for Likelihood and Consequence and placing the corresponding Risk no. from the adjacent cell in each row onto a heat map but I am now wanting to change the code below to add the 2 column values instead of multiplying them, help please.
The formula used on the sheet is;

=ProbSevScore($E5,G$2,$A$3:$A$42)

....and this is the vba function

Function ProbSevScore(Prob As Integer, Sev As Integer, Nbr As Range)
Application.Volatile True
Dim Cell As Range
ProbSevScore = ""
For Each Cell In Nbr
PScore = Right(Cell.Offset(0, 1), 1) + 0
SScore = Right(Cell.Offset(0, 2), 1) + 0
If PScore = Prob Then
If SScore = Sev Then
If Len(ProbSevScore) > 0 Then ProbSevScore = ProbSevScore & ","
ProbSevScore = ProbSevScore & Cell.Value
End If
End If
Next Cell


End Function

Re: Change font colour

Hi Alan. Cheers I sort of worked out adding your code for myself but it takes forever as it looks at each character and there are 1000's of them in the column. This is what I have now.

Sub colorWhite()
    Dim c As Range
    Dim lr As Long
    lr = Range("M" & Rows.Count).End(xlUp).Row
    Dim rng As Range
    Set rng = Range("M1:M" & lr)
    For Each c In rng
        With c
            For i = 1 To Len(.value)
                If .Characters(i, 1).Font.ColorIndex = 50 Then
                    .Characters(i, 1).Font.ColorIndex = 2
                End If
            Next i
        End With
    Next c
End Sub

Re: Change font colour

Thanks Alan but it appears to only works in cells where all the text is green. Each of my cells has lines of text that are green and lines of text that are black and I only want to change the lines that are green.

Hi I am stumbling with this so ask for your help please.
My spread sheet has dozen or more columns with cells that contain multiple lines of text.
In one column some of these lines of text are colored green and I would like code to hide the lines that are green by coloring them white when necessary, then un-hide by changing them back to green.
I found and adapted this code but it looks at the entire spread sheet instead of just one column and takes forever before crashing.

Sub colorWhite()
Dim i As Long, c As Range
For Each c In ActiveSheet.UsedRange
    With c
        For i = 1 To Len(.Value)
            If .Characters(i, 1).Font.ColorIndex = 4 Then
                .Characters(i, 1).Font.ColorIndex = 2
               
            End If
        Next i
    End With
Next c
End Sub

Re: error #2038

Hey thanks for that Macro Man I zipped the file and its loaded. Perhaps you can help me with what I need, the post is called - Excel to outlook calendar

Hi
I'm trying to upload an xlsx file on another thread but when doing so a popup comes up with error #2038 and the file cannot be uploaded.
Could someone please kindly explain why this happens and what to do to resolve the issue?
All help appreciated

Re: Latest entry

Thanks for your brilliance Jindon, I changed the date format and it's worked perfectly. If you're ever in Auckland dinner is on me

Re: Latest entry

Hi Jindon
Thanks for taking the time to look at this for me, I'm new to this and appreciate any and all help I can get.
What I'm after is the row based on the latest date each person ordered to appear on a new sheet.
Cheers

My spreadsheet has several thousand rows containing, amongst other information, names of clients and the dates they have been visited (these vary from case to case) . To save time I am after code that will enable the row that has the latest date each client was visited to be displayed on a new separate sheet.
Help here would be well received.

Sheet 1(existing sheet)
A B C
9/April/2015 Bill 3
8/March/2015 Gavin 3
8/March/2015 Bill 4
1/April/2015 Gavin 2

Sheet 2 (new sheet)
A B C
9/April/2015 Bill 3
1/April/2015 Gavin 2

Re: VBA to resize row to the same as tallest text box in that row

I worked out that by adding parenthesis to the sheet name, i.e. With Sheets("Sheet7") fixed the problem.
The reason for text boxes is to allow better formatting, in this case bullet points and indenting.
If anyone can help me use the colour of source cells to format a 3D graph you'd be my new best friend. I manually do this and each time the data changes I have to update the appropriate column.

[ATTACH=CONFIG]60857[/ATTACH]

Re: VBA to resize row to the same as tallest text box in that row

Hi Luke, thanks for helping me, you probably already figured out that I'm new to VBA.

When I run the code I get Run - time error '1004' Application - defined or object defined error and when debugging this part of the code highlights.

.Rows(mht(i, 2)).Rowheight = mht(i, 1)

Re: VBA to resize row to the same as tallest text box in that row

No, I haven't and I didn't realise I'd have to name each text box - the spreadsheet will have hundreds of them when complete!

I need help to make rows expand to fit the largest text box within that row. I found the code below online, it works perfectly on the spreadsheet it came on but it doesn't work on my spreadsheet.
Any help will be appreciated.
Thanks in advance

Sub Adjust()
Dim cr As Range
Dim ht As Single
Dim mht As Variant
Dim cn As Integer
Dim n As Variant
Dim rp As Integer
Dim i As Integer
n = 1
Application.ScreenUpdating = False
With Sheets(1)
    cn = .Shapes.Count
    ReDim mht(cn, 2)
    For i = 1 To cn
        With .Shapes(i)
        If .Name Like "TextBox*" Then
            Set cr = .TopLeftCell
            If i = 1 Then rp = cr.Row
            If rp <> cr.Row Then
                n = n + 1
                rp = cr.Row
            End If
            ht = .Height
            If ht > mht(n, 1) Then mht(n, 1) = ht
            mht(n, 2) = rp
        End If
        End With
    Next i
    For i = 1 To n
        .Rows(mht(i, 2)).RowHeight = mht(i, 1)
    Next i
End With
End Sub

Re: If B = "EFTPOS" move A2 to A3, C2 to C3 then delete row 2. Loop to end of sheet

Thank you so much, it worked perfectly. One day I hope to be able to repay you!!!

[TABLE="width: 500, align: left"]

[TD="align: center"][/TD]
[TD="align: center"]A
[/TD]
[TD="align: center"]B
[/TD]
[TD="align: center"]C
[/TD]

1

date

transaction details

amount

2

26.3.2014

EFTPOS

100.00

3

Supermarket

4

EFTPOS

50.00

5

Tyre Shop

6

25.3.2014

EFTPOS

105.67

7

Mobil

8

24.3.2014

Bakery

8.50

[/TABLE]

[TABLE="width: 500, align: left"]

[TD="align: center"][/TD]
[TD="align: center"]A
[/TD]
[TD="align: center"]B
[/TD]
[TD="align: center"]C
[/TD]

1

date

transaction details

amount

2

26.3.2014

Supermarket

100.00

3

Tyre Shop

50.00

4

25.3.2014

Mobil

105.67

5

24.3.2014

Bakery

8.50

[/TABLE]