Posts by ir121973

Re: VBA Remove Characters

Hi snb, thank you for taking the time to reply to my post, and for the solution.

I have to admit the code I'm using was derived from items I've picked up off the web, and from help I've received through this project I'm working on, so it is very possible that this an incorrect way of writing this particular function.

Many thanks and kind regards

Re: VBA Remove Characters

Hi jindon, thank you for taking the time to reply to my post and for the guidance.

I've made the changes as you suggested, but sadly, this doesn't have the desired result.

This part of the code works fine:

With ws.Range("D5", ws.Range("D" & Rows.Count).End(xlUp))
                    .Value = Evaluate("if(row(" & .Address & "),replace(" & .Address & ",1,10,""""))")
 End With

But the the column of data is removed completely from the other sheets in the array, which is controlled by this line of code:

With ws.Range("C5", ws.Range("C" & Rows.Count).End(xlUp))
                    .Value = Evaluate("if(row(" & .Address & "),replace(" & .Address & ",1,10,""""))")
End With

So I'm not sure where I'm going wrong.

Many thanks and kind regards

Hi, I wonder whether someone may be able to help me please.

I've put together the following code which performs a number of actions within given columns in a sheet array.

Sub MonthlyFormatSheets()
    
    Dim ws As Worksheet
    Dim rng As Range
    Dim LastRow As Long
    
    Const StartRow As Long = 5
    
    For Each ws In Worksheets(Array("Monthly Projects", "Monthly Direct Activities", "Monthly Enhancements", "Monthly Indirect Activities", "Monthly Overheads"))
        
        LastRow = ws.Cells(Rows.Count, "B").End(xlUp).Row
        If LastRow >= StartRow Then
            If ws.Name = "Monthly Projects" Then
                ws.Range("B5:G" & LastRow).Cells.Font.Name = "Lucinda Sans"
                ws.Range("B5:G" & LastRow).Cells.Font.Size = 10
                ws.Range("E5:G" & LastRow).NumberFormat = "#,##0.000"
                ws.Range("E5:G" & LastRow).HorizontalAlignment = xlCenter
                With Range("C5:C" & LastRow)
                    .Replace " ", ""
                    .Replace "_", ""
                End With
                ws.Sort.SortFields.Clear
                ws.Sort.SortFields.Add Key:=Range("B5"), _
                SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                With ws.Sort
                    .SetRange Range("B5:F" & LastRow)
                    .Header = xlNo
                    .MatchCase = False
                    .Orientation = xlTopToBottom
                    .SortMethod = xlPinYin
                    .Apply
                End With
                ws.Range("G5:G" & LastRow).FormulaR1C1 = "=RC5-RC6"
                
                With ws.Range("D5", Range("D" & Rows.Count).End(xlUp))
                    .Value = Evaluate("if(row(" & .Address & "),replace(" & .Address & ",1,10,""""))")
                End With
                
          
                ws.Columns("B:G").AutoFit
            Else
                ws.Range("B5:F" & LastRow).Cells.Font.Name = "Lucinda Sans"
                ws.Range("B5:F" & LastRow).Cells.Font.Size = 10
                ws.Range("D5:F" & LastRow).NumberFormat = "#,##0.000"
                ws.Range("D5:F" & LastRow).HorizontalAlignment = xlCenter
                ws.Sort.SortFields.Clear
                ws.Sort.SortFields.Add Key:=Range("B5"), _
                SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                With ws.Sort
                    .SetRange Range("B5:E" & LastRow)
                    .Header = xlNo
                    .MatchCase = False
                    .Orientation = xlTopToBottom
                    .SortMethod = xlPinYin
                    .Apply
                End With
                ws.Range("F5:F" & LastRow).FormulaR1C1 = "=RC4-RC5"
                
                With ws.Range("C5", Range("C" & Rows.Count).End(xlUp))
                    .Value = Evaluate("if(row(" & .Address & "),replace(" & .Address & ",1,10,""""))")
                End With
            
                ws.Columns("B:F").AutoFit
            End If
        End If
        Next ws
    End Sub

Unfortunately though I'm having a problem with the following sections of code which removes the first 10 characters from a text string:

With ws.Range("D5", Range("D" & Rows.Count).End(xlUp))
                    .Value = Evaluate("if(row(" & .Address & "),replace(" & .Address & ",1,10,""""))")
End With

and

With ws.Range("C5", Range("C" & Rows.Count).End(xlUp))
                    .Value = Evaluate("if(row(" & .Address & "),replace(" & .Address & ",1,10,""""))")
 End With

When I run this, I receive Run time error '1004' Method Range of Object_worksheet failed' with debug highlighting this line as the cause

With ws.Range("D5", Range("D" & Rows.Count).End(xlUp)

) and I've no idea why despite spending several hours on this with different permutations of code.

In addition, I would like to add an 'IF' statement which states that the first character must be / before it removes the 10 characters.

I just wondered whether someone may be able to look at this and let me know where I'm going wrong.

Many thanks and the kindest regards

Re: VBA Conditional Format

Hi olivetwist, thank you for taking the time to reply to my post. I must admit, I'd not even thought of this, but I'll certainly given this a try.

Thank you for the guidance.

Kind Regards

Hi, I wonder whether someone may be able to help me please.

I'm using the code below to perform a number of actions to a series of columns within a given array.

Sub MonthlyFormatSheets()
    
    Dim ws As Worksheet
    Dim rng As Range
    Dim LastRow As Long
    
    Const StartRow As Long = 5
    
    For Each ws In Worksheets(Array("Monthly Projects", "Monthly Direct Activities", "Monthly Enhancements", "Monthly Indirect Activities", "Monthly Overheads"))
        
        LastRow = ws.Cells(Rows.Count, "B").End(xlUp).Row
        If LastRow >= StartRow Then
            If ws.Name = "Monthly Projects" Then
                ws.Range("B5:G" & LastRow).Cells.Font.Name = "Lucinda Sans"
                ws.Range("B5:G" & LastRow).Cells.Font.Size = 10
                ws.Range("E5:G" & LastRow).NumberFormat = "#,##0.000"
                ws.Range("E5:G" & LastRow).HorizontalAlignment = xlCenter
                ws.Range("G5:G" & LastRow).FormulaR1C1 = "=IF(RC[-2]<0.000,"""",RC[-2]-RC[-1])"

You'll see that in this line

ws.Range("G5:G" & LastRow).FormulaR1C1 = "=IF(RC[-2]<0.000,"""",RC[-2]-RC[-1])"

I apply a formula and it's this that I'm having a little trouble with.

The formula works find but I'm trying to add conditional format, whereby if the value in column G is => 0.00 I'd like the font to be green, if it <0.00 then I'd like the font to be red.

I've done a fair bit of research, but I've been unable to find a sutiable solution which I can work at adapting.

I just wondered whether someone may be able to look at this please and offer some guidance on how I may go about achieving this.

Many thanks and kind regards

Re: VBA Change Date Cell Value

Hi PCI, thank you for taking the time to reply to my post and for the guidance, it is greatly appreciated.

All the best and kind regards

Re: VBA Change Date Cell Value

Hi All, thank you for taking the time to view my post.

I've managed to solve this by using the following:

With Range("I21")
.NumberFormat = "@"
.Value = Format(Date, "mmm yy")


End With

Many thanks and kind regards

Hi, I wonder whether someone may be able to help me please.

I've put together a script which consolidates sheets from multiple workbooks into a 'Summary' sheet.

One of the columns contains dates which, when extracted, are in the format of "mmm yy", but the actual cell value is for example, "01/11/13 01:00:00".

Could someone perhaps tell me please is there a way using VB, where I can replace the cell value from, and using the above example, "01/11/13 01:00:00" to "01/11/13". The reason I need to do this is so the cell value can be compared to another cell further along in my script.

Many thanks and kind regards

Re: VBA Multiply Figure By

Hi Windy, thank you very much for taking the time to reply to my post and for the solution. It works great!

Thank you for also for your time and trouble.

Kind Regards

Re: VBA Highlight Highest &amp; Second Highest Value In Each Column

Hi Smallman, thank you for taking the time to reply to my post and for the solution. It is greatly appreciated.

Many thanks and kind regards

Re: VBA Multiply Figure By

Hi royUK, thank you for taking the time to reply to my post.

Please find attached the file you asked for. The file consists of all the sheets in the array, and I've also included the start of the script which I wanting to adapt with this new function.

Many thanks and kind regards

Re: VBA Highlight Highest &amp; Second Highest Value In Each Column

Hi yegarboy, that's great. Thank you very much for your time and trouble.

Kind Regards

Hi, I wonder whether someone may be able to help me please.

I have the following sheet layout.

[TABLE="width: 1500"]

COLUMN B

COLUMN C

COLUMN D

COLUMN E

COLUMN F

COLUMN G

COLUMN H

COLUMN I

COLUMN J

COLUMN K

COLUMN L

COLUMN M

COLUMN N

COLUMN O

COLUMN P

COLUMN Q

ROW 3

22

23

20

23

22

21

23

21

22

23

20

21

ROW 4

Description

Apr-13

May-13

Jun-13

Jul-13

Aug-13

Sep-13

Oct-13

Nov-13

Dec-13

Jan-14

Feb-14

Mar-14

Actual Hours Total

Mandays Total

FTE Total

ROW 5

Project 1

1155.14

1463.71

1615.53

1333.76

232.01

32.05

[/TABLE]

What I'm trying to do, is add a formula via VBA in the "FTE" column (Column Q), which is as follows:

• Search row 5 in columns C:N and find the month which matches the current date.
• When a match is found, take the corresponding value from row 4 and multiply this value by the value in column P.
• So using the above as an example, the formula in column Q on row 5, would be 22 multiplied by 32.05 giving a total of 705.10.

Sub Extract()


    Dim ws As Worksheet, LastRow As Long
    Const StartRow As Long = 5
            
        For Each ws In Worksheets(Array("Direct Activities", "Enhancements", "Indirect Activities", "Overheads", "Projects"))
            LastRow = ws.Cells(Rows.Count, "B").End(xlUp).Row
            If LastRow >= StartRow Then
                ws.Range("B5:B" & LastRow).NumberFormat = "@"
                ws.Range("C5:P" & LastRow).NumberFormat = "0.00"
            
            End If
            ws.Columns("B:Q").AutoFit
            
        Next ws
     Application.ScreenUpdating = True
    End Sub

Hi, I wonder whether someone may be able to help me please.

I have the following sheet layout.

[TABLE="width: 1500"]

COLUMN B

COLUMN C

COLUMN D

COLUMN E

COLUMN F

COLUMN G

COLUMN H

COLUMN I

COLUMN J

COLUMN K

COLUMN L

COLUMN M

COLUMN N

COLUMN O

COLUMN P

COLUMN Q

ROW 3

22

23

20

23

22

21

23

21

22

23

20

21

ROW 4

Description

Apr-13

May-13

Jun-13

Jul-13

Aug-13

Sep-13

Oct-13

Nov-13

Dec-13

Jan-14

Feb-14

Mar-14

Actual Hours Total

Mandays Total

FTE Total

ROW 5

Project 1

1155.14

1463.71

1615.53

1333.76

232.01

32.05

[/TABLE]

What I'm trying to do, is add a formula via VBA in the "FTE" column (Column Q), which is as follows:

• Search row 5 in columns C:N and find the month which matches the current date.
• When a match is found, take the corresponding value from row 4 and multiply this value by the value in column P.
• So using the above as an example, the formula in column Q on row 5, would be 22 (Because we are in August) multiplied by 32.05 (Cell P5) giving a total of 705.10.

I know how to set up my sheet and range array using the code I've put together below, but it's the formula I'm having difficulty with.

Sub Extract()


    Dim ws As Worksheet, LastRow As Long
    Const StartRow As Long = 5
            
        For Each ws In Worksheets(Array("Direct Activities", "Enhancements", "Indirect Activities", "Overheads", "Projects"))
            LastRow = ws.Cells(Rows.Count, "B").End(xlUp).Row
            If LastRow >= StartRow Then
                ws.Range("B5:B" & LastRow).NumberFormat = "@"
                ws.Range("C5:P" & LastRow).NumberFormat = "0.00"
            
            End If
            ws.Columns("B:Q").AutoFit
            
        Next ws
     Application.ScreenUpdating = True
    End Sub

I just wondered whether someone could possibly look at this please and offer some guidance on how I may go about achieving this.

Many thanks and kind regards

Re: VBA Highlight Highest &amp; Second Highest Value In Each Column

Hi yegarboy, thank you very much for taking the time to reply to my post.

The code works, but it starts searching at row 4 which is the header row. Could you possibly tell me please how I may be able to make the change to start at row 5.

Many thanks and kind regards

Hi, I wonder whether someone could possibly help me please.

I'm trying to put together a script which will highlight the highest and second highest value for each column in a given range for multiple sheets.

I've started the script off below, which I think correctly creates the array of sheets and the starting row of each column.

Sub Highlight()


    Dim ws As Worksheet, Worksheet, LastRow As Long
    Const StartRow As Long = 5
    
    Application.ScreenUpdating = False
        
        For Each ws In Worksheets(Array("Direct Activities", "Enhancements", "Indirect Activities", "Overheads", "Projects"))
            LastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
             If LastRow >= StartRow Then






            End If
            ws.Columns("B:Q").AutoFit
            
        Next ws
     Application.ScreenUpdating = True
    End Sub

Now I did try to get some help here: http://www.excelforum.com/exce…ighlight-max-numbers.html but as you will see I seem to have hit a bit of brick wall.

I just wondered whether someone could possibly look at this please, and offer some guidance on how I may go about achieiving this.

Thank you and kind regards

Re: VBA Create Unique Distinct Values List

Hi snb. Thank you very much for your suggestion. Although I'd like to continue with jindon solution in this instance, but thank you for helping me to think a little less blinkered.

I also like your website. I'll be looking at this over the next few days.

Many thanks and kind regards

Re: VBA Create Unique Distinct Values List

Hi jindon, that's absolutely no problem at all. Thank you for your reply.

Re: VBA Create Unique Distinct Values List

Hi jindon, I can only apologise for my stupidity and illness, a long story.

I can completely understand your frustration.

Please find attached the file you've asked for. I have added two extra sheets called "Direct Activities Output" and "Indirect Activities" highlighting the desired outcome.

Once again, my sincere apologies for really messing you around and thanks for all your time, trouble and patience.

Kind Regards

Re: VBA Create Unique Distinct Values List

Hi jindon, that's great, but I'm afraid I've made a terrible, terrible mistake, I am so sorry!

In the case of "DIR" and "IND", would it be at all possible please to copy the value from column D of the 'Source' sheet rather than column E, pasting into column B of the "Direct Activities" and "Indirect Activities" 'Destination' sheets.

I feel a real idiot, for not spotting this before, I'm so very sorry. I promise you that this is the last change!

Many thanks and kind regards.