Posts by ir121973

ir121973 · Nov 27th 2013

Re: VBA Extract Highest and Second Highest Values

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

Rather than troubling you further, I will work with the solution provided by apo.

All the best and kind regards

ir121973 · Nov 27th 2013

Re: VBA Extract Highest and Second Highest Values

Hi apo, thank you very much for taking the time to reply to my post and form putting the solution togther which works great.

May I just ask please, if I wanted to change the first 'Destination' cell from J to K, in addition to the changes that need to be made on this line:

Code

For Each rng1 In Sheets(2).Range("J7:J" & Sheets(2).Range("J" & Rows.Count).End(xlUp).Row)

what other lines would need to be amended please?

May I also ask one more favour, would it be at all possible for you to insert some notes into the code please which explains which each part of the code does, because I am very keen to learn as I go along.

Many thanks and kind regards

ir121973 · Nov 26th 2013

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

I'm attempting to put together a script which in simple terms finds the 'Highest and Second' highest activity and associated FTE for a given sub group.

To be more specific:

On the "Slide 1" sheet look at the values in column J starting at row 7 until blank;
For each value, then search the "All Monthly Direct Activities" sheet in column C for the same value, excluding the 'Subtotal' rows;
Where a match is found, compare all the values in column E for that sub group;
And Find the highest and second highest figure;

Once these are found copy this figure and associated value in column B and paste onto the "slide 1" sheet.

I have posted on ExcelForum here http://www.excelforum.com/exce…cond-highest-figures.html and did receive some help as you will see but I still have an outstanding issue.

I'm not particularly well versed in writing VB, but I've been working with the code to see if I can get this work, which I have been unable to do.

I have attached a file which may perhaps provide a greater detail than my description of the problem containing the 'Source' and 'Destination' sheets.

I just wondered whether someone could possibly look at this please and feel they may be able to help

Many thanks and kind regards

ir121973 · Nov 26th 2013

Re: VBA Count Unqiue Values With Multiple Criteria

Hi royUK, thank you for taking the time to reply to my post. Unfortunately I'm using Excel 2003, so I'm unable to use the 'CountIfs' function.

Many thanks and kind regards

ir121973 · Nov 26th 2013

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

I'm using the following array formula in cell M7 on my sheet:

Quote

=SUM(--(FREQUENCY(IF((JRole=K7)*(Period=B3)*(PLOB=M6)*(PName<>"*DIR*")*(PName<>"*Enhancements*")*(PName<>"*IND*")*(PName<>"*OVH*")*(SName<>""), MATCH(SName,SName&"",0)),ROW(SName)-ROW(B4)+1)>0))

The formula works fine, but my problem is two fold.

I'd now like to extend the formula so that it is present in every cell in the range M7:U7, with the 'PLOB=M6' element of the formula changing to the current cell minus 1 row, which I'm very unsure of how to do,
The other issue I have is that this formula causes the spreadsheet to run slow. This will only be

exacerbated when all of the formula have been added, so I wonder whether I may need to use a VB script

As you are probably aware, I'm unsure how to progress this, so I just wondered whether someone may be able to look at this please and offer some guidance on how I may go about resolving this.

Many thanks and kind regards

ir121973 · Nov 20th 2013

Re: VBA Create & Format Sheet

Hi royUK, thnk you very much for taking the time to reply to my post, and for the guidance and lik. It is greatly apprciated.

Kind Regards

ir121973 · Nov 20th 2013

Re: VBA Create & Format Sheet

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

Kind regards

ir121973 · Nov 19th 2013

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

I'm using the code below to create and format a sheet within my workbook.

Code

Sub CreateSlide1()
    
    Set Ash = ActiveSheet
    Set newsht = Worksheets.Add(after:=Worksheets(14))
    newsht.Name = "Slide 1"
    
    With newsht
        With .Range("B5")
            .Value = ("Projects")
            .Cells.Font.Name = "Lucida Sans"
            .Cells.Font.Size = 11
            .Font.Bold = True
            .Font.ColorIndex = 2
            .HorizontalAlignment = xlCenter
            .Interior.ColorIndex = 11
            .Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(0, 2)).Merge
        End With
            
        With .Range("B7:D7")
            .Value = Array("Resource LOB", "No.of Projects", "Actuals Projects FTE")
            .Cells.Font.Name = "Lucida Sans"
            .Cells.Font.Size = 10
            .Font.Bold = True
            .Font.ColorIndex = 2
            .HorizontalAlignment = xlCenter
            .Interior.ColorIndex = 11
        End With
            
        With .Range("G5")
            .Value = ("Enhancements")
            .Cells.Font.Name = "Lucida Sans"
            .Cells.Font.Size = 11
            .Font.Bold = True
            .Font.ColorIndex = 2
            .HorizontalAlignment = xlCenter
            .Interior.ColorIndex = 11
            .Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(0, 1)).Merge
        End With
        
         With .Range("G7:H7")
            .Value = Array("Resource LOB", "Actuals Enhancements FTE")
            .Cells.Font.Name = "Lucida Sans"
            .Cells.Font.Size = 10
            .Font.Bold = True
            .Font.ColorIndex = 2
            .HorizontalAlignment = xlCenter
            .Interior.ColorIndex = 11
        End With
    End With
End Sub

Display More

The code wotrks fine, but I'm aware it's a little messy and perhaps a little longer than it needs to be.

I just wondered whether someone, perhaps with a greater experience than I, may be able to look at this please and offer some guidance on how I may go about tidying this up.

Many thanks and kind regards

ir121973 · Nov 16th 2013

Re: VBA Display Input Box and Extract Files

Hi holycow, since your last post I've been working on this and by using two posts I found on this site here http://www.ozgrid.com/forum/showthread.php?t=59228 & http://www.ozgrid.com/forum/showthread.php?t=69382 I've been able to move my script on considerably and I've been able to get this to work.

For info, my code is now as follows:

Code

Sub ConsolidateTimeRecording()


    Dim DestWB As Workbook
    Dim dR As Long
    Dim Fd As FileDialog
    Dim LastRow As Long
    Dim SourceSheet As String
    Dim sFile As String '****New line
    Dim sMidFile As String '****New line
    Dim StartRow As Long
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim path As Variant
    Dim excelfile As Variant


    Set DestWB = ActiveWorkbook


    SourceSheet = "Input"
    StartRow = 2


    Range("B4:N4").Select


    Selection.AutoFilter


MidFile = InputBox("Please Enter The Month You Wish To Open")
    sFile = "D:\Work Files\" & MidFile & "\Time Recording\"


    excelfile = Dir(sFile & "*.xls")
    Do While excelfile <> ""


        Set wb = Workbooks.Open(Filename:=sFile & excelfile, ReadOnly:=True, Password:="master")
            For Each ws In wb.Worksheets
                If ws.Name = SourceSheet Then
                    With ws
                        If .UsedRange.Cells.count > 1 Then
                            dR = DestWB.Worksheets("Time Recording").Range("B" & DestWB.Worksheets("Time Recording").Rows.count).End(xlUp).Row + 1
                            If dR < 5 Then dR = 6  'destination start row
                                LastRow = .Range("A" & Rows.count).End(xlUp).Row
                                If LastRow >= StartRow Then
                                    .Range("A" & StartRow & ":M" & LastRow).Copy
                                    DestWB.Worksheets("Time Recording").Cells(dR, "B").PasteSpecial xlValues
                                    DestWB.Worksheets("Time Recording").Range("B5:N" & LastRow).Font.Name = "Lucida Sans"
                                    DestWB.Worksheets("Time Recording").Range("B5:N" & LastRow).Font.Size = 10
                                    DestWB.Worksheets("Time Recording").Range("K5:N" & LastRow).NumberFormat = "#,##0.00"
                                    DestWB.Worksheets("Time Recording").Range("K5:N" & LastRow).HorizontalAlignment = xlCenter
                                End If
                            End If
                    End With
            Exit For
        End If
    Next ws
    wb.Close savechanges:=False
    ' Next file in folder
        excelfile = Dir
    Loop




    Application.CutCopyMode = False




    msg = MsgBox("All Time Recording files have been consolidated", vbInformation)




    Columns("B:N").AutoFit
End Sub

Display More

Many thanks for your time trouble and patience.

All the best and kind regards

ir121973 · Nov 15th 2013

Re: VBA Display Input Box and Extract Files

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

I'm now working on the file at home, so my file path has changed to

Code

sFile = "\\D:WorkFiles\" & mo & "\Time Recording\ & "

but I am still receiving the error, which I suppose in some respects is good news.

As you suggested I went into the 'Immediate' window and the results were as follows:

Quote

D:\Work Files\Extract Macro.xls

with "Extract Macro" being the name of my file.

Many thanks and kind regards

ir121973 · Nov 15th 2013

Re: VBA Display Input Box and Extract Files

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

Forgive me for asking, but could you possibly tell me how to navigate to these filea s I've not used these before.

Many thanks and kind regards

Chris

ir121973 · Nov 15th 2013

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

I'm trying to put together a script which performs the following:

Display a Input Box to user
User enters a month name
Once a month has been selected open the "Time Recording" folder automatically and extract the files automatically, copying pertinent data, pasting this into a "Summary" sheet.

Code

Sub ConsolidateTimeRecording()
    Dim DestWB As Workbook
    Dim dR As Long
    Dim Fd As FileDialog
    Dim LastRow As Long
    Dim SourceSheet As String, sMo As Variant
    Dim sFile As String, mo As String
    'Dim sPath As String
    Dim StartRow As Long
    Dim wb As Workbook
    Dim ws As Worksheet
    Set DestWB = ActiveWorkbook
    SourceSheet = "Input"
    StartRow = 2
    Range("B4:N4").AutoFilter
    sMo = "January, February, March, April, May, June, July, August, September, October, November, December"
    mo = InputBox("Please enter the month for the file to retrieve, expl: January", "MONTH OF FIle")
        If InStr(sMo, mo) = 0 Or mo = "" Then
            MsgBox "A valid month name was not entered"
            Exit Sub
        End If
         sFile = "\\Irf01234\ims r and d management\D&RM\Reporting\Chris Test\" & mo & "\Time Recording\ "
        Do While sFile <> ""
        Set wb = Workbooks.Open(Filename:=sFile, ReadOnly:=True, Password:="master")
            For Each ws In wb.Worksheets
                If ws.Name = SourceSheet Then
                    With ws
                        If .UsedRange.Cells.count > 1 Then
                            dR = DestWB.Worksheets("Time Recording").Range("B" & DestWB.Worksheets("Time Recording").Rows.count).End(xlUp).Row + 1
                            If dR < 5 Then dR = 6  'destination start row
                                LastRow = .Range("A" & Rows.count).End(xlUp).Row
                                If LastRow >= StartRow Then
                                    .Range("A" & StartRow & ":M" & LastRow).Copy
                                    DestWB.Worksheets("Time Recording").Cells(dR, "B").PasteSpecial xlValues
                                    DestWB.Worksheets("Time Recording").Range("B5:N" & LastRow).Font.Name = "Lucida Sans"
                                    DestWB.Worksheets("Time Recording").Range("B5:N" & LastRow).Font.Size = 10
                                    DestWB.Worksheets("Time Recording").Range("K5:N" & LastRow).NumberFormat = "#,##0.00"
                                    DestWB.Worksheets("Time Recording").Range("K5:N" & LastRow).HorizontalAlignment = xlCenter
                                End If
                            End If
                    End With
            Exit For
        End If
    Next ws
    wb.Close savechanges:=False
    ' Next file in folder
    sFile = Dir
  Loop
    Application.CutCopyMode = False
    msg = MsgBox("All Time Recording files have been consolidated", vbInformation)
    Columns("B:N").AutoFit
End Sub

Display More

The problem I have is that when I run this I recieve the following error: "\\Irf01234\ims r and d management\D&RM\Reporting\Chris Test\November\Time Recording.xls" cannot be found.

Debug then highlights this line as the cause:

Code

Set wb = Workbooks.Open(Filename:=sFile, ReadOnly:=True, Password:="master")

When the 'Input Box' is displayed to the user, the file path should be

Code

"\\Irf01234\ims r and d management\D&RM\Reporting\Chris Test\

The user then types the month name e.g. November so the file path will become

Code

"\\Irf01234\ims r and d management\D&RM\Reporting\Chris Test\November

I would then like the script to automatically open the "Time Recording" folder and automatically open and extract the data from the files within the "Time Recording" folder.

I just wondered whether someone could possibly look at this please and let me know where I'm going wrong.

Many thanks and kind regards

ir121973 · Nov 9th 2013

Re: VBA Browse & Extract From Multiple Files

Hi cytop, thank you for taking the time to reply to my post, and my apologies for not getting back to you sooner.

I've now amended my script to the following which doesn't as yet, overcome the password issue, but it allows the user to select the files to open.

Code

Sub MergeOriginal()




      Dim DestWB As Workbook, WB As Workbook, WS As Worksheet, SourceSheet As String
      Set DestWB = ActiveWorkbook
      SourceSheet = "Input"
      StartRow = 2
      FileNames = Application.GetOpenFilename( _
      filefilter:="Excel Files (*.xls*),*.xls*", _
      Title:="Select the workbooks to merge.", MultiSelect:=True)
      If IsArray(FileNames) = False Then
          If FileNames = False Then
              Exit Sub
          End If
      End If
      For n = LBound(FileNames) To UBound(FileNames)
          Set WB = Workbooks.Open(Filename:=FileNames(n), ReadOnly:=True)
          For Each WS In WB.Worksheets
              If WS.Name = SourceSheet Then
                         With WS
                        If .UsedRange.Cells.Count > 1 Then
                            dr = DestWB.Worksheets("Time Recording").Range("B" & DestWB.Worksheets("Time Recording").Rows.Count).End(xlUp).Row + 1
                                If dr < 5 Then dr = 6 'destination start row
                                    LastRow = .Range("A" & Rows.Count).End(xlUp).Row
                                        If LastRow >= StartRow Then
                                            .Range("A" & StartRow & ":M" & LastRow).Copy
                                                DestWB.Worksheets("Time Recording").Cells(dr, "B").PasteSpecial xlValues
                                                DestWB.Worksheets("Time Recording").Range("B5:N" & LastRow).Font.Name = "Lucida Sans"
                                                DestWB.Worksheets("Time Recording").Range("B5:N" & LastRow).Font.Size = 10
                                                DestWB.Worksheets("Time Recording").Range("K5:N" & LastRow).NumberFormat = "#,##0.00"
                                                DestWB.Worksheets("Time Recording").Range("K5:N" & LastRow).HorizontalAlignment = xlCenter
                                        End If
                                    End If
                                End With
                            Exit For
                        End If
                    Next WS
          WB.Close savechanges:=False
      Next n
  End Sub

Display More

However, I would like to adapt this a little so that the user only has to select the folder to open and the files open automatically.

I just wondered whether you may be able to offer some guidance on how I may go about achieving this.

Many thanks and kind regards

ir121973 · Nov 8th 2013

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

I'm using the code below to automatically open multiple password protected files and extract pertinent data from each, amalgamating them into a "Summary" sheet.

Code

Sub ConsolidateTimeRecording()
    
    Dim DestWB As Workbook
    Dim dr As Long
    Dim FileNames As Variant
    Dim LastRow As Long
    Dim n As Long
    Dim SourceSheet As String
    Dim StartRow As Long
    Dim wb As Workbook
    Dim ws As Worksheet
    Set DestWB = ActiveWorkbook
    
    SourceSheet = "Input"
    StartRow = 2
    
    Range("B4:M4").Select
    
    Selection.AutoFilter
    
    FileNames = ThisWorkbook.Worksheets("File List").Range("B4:B11").Value
    For n = LBound(FileNames, 1) To UBound(FileNames, 1)
        
        Set wb = Workbooks.Open(Filename:=FileNames(n, 1), ReadOnly:=True, Password:=ThisWorkbook.Worksheets("File List").Range("C4:C11").Cells(n).Value)
            For Each ws In wb.Worksheets
                If ws.Name = SourceSheet Then
                    With ws
                        If .UsedRange.Cells.count > 1 Then
                            dr = DestWB.Worksheets("Time Recording").Range("B" & DestWB.Worksheets("Time Recording").Rows.count).End(xlUp).Row + 1
                                If dr < 5 Then dr = 6 'destination start row
                                    LastRow = .Range("A" & Rows.count).End(xlUp).Row
                                        If LastRow >= StartRow Then
                                            .Range("A" & StartRow & ":M" & LastRow).Copy
                                                DestWB.Worksheets("Time Recording").Cells(dr, "B").PasteSpecial xlValues
                                                DestWB.Worksheets("Time Recording").Range("B5:N" & LastRow).Font.Name = "Lucida Sans"
                                                DestWB.Worksheets("Time Recording").Range("B5:N" & LastRow).Font.Size = 10
                                                DestWB.Worksheets("Time Recording").Range("K5:N" & LastRow).NumberFormat = "#,##0.00"
                                                DestWB.Worksheets("Time Recording").Range("K5:N" & LastRow).HorizontalAlignment = xlCenter
                                        End If
                                    End If
                                End With
                            Exit For
                        End If
                    Next ws
            
    Application.CutCopyMode = False
    wb.Close savechanges:=False
    
    Next n
        
    msg = MsgBox("All Clarity files have been consolidated", vbInformation)
    Columns("B:N").AutoFit
End Sub

Display More

In it's current form, the filepath and password for each file are hardcoded into a sheet called "File List", and are read in this piece of code:

Code

FileNames = ThisWorkbook.Worksheets("File List").Range("B4:B11").Value
    For n = LBound(FileNames, 1) To UBound(FileNames, 1)
        
    Set wb = Workbooks.Open(Filename:=FileNames(n, 1), ReadOnly:=True, Password:=ThisWorkbook.Worksheets("File List").Range("C4:C11").Cells(n).Value)

All of the 'Source' files will be located in monthly folders, so I'm looking to amend the code so the user can browse and select the folder they wish to extract the files from.

I've found quite a few examples of creating a script which allows the user to brosw for a folder, but I'm having difficulty in trying to open the password protected files and then extract the pertinent data.

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 kindm regards

ir121973 · Oct 27th 2013

Re: VBA Loop At Each Value Change

HI PCI, thank you for taking the time to reply to my post and for the suggestion.

I had thought of using a Pivot table, but some of my colleagues using this have very limited Excel knowledge, and in addition, as this will be part of a larger script I was trying to put together a VB script.

Many thanks and kind regards

ir121973 · Oct 26th 2013

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

I'm trying to put together a script which look at the "Monthly Projects" and create a loop that will take the info from each row in column B and group it by the data in column C. In addition I would like to to 'Sum' the values in column E for each change in column C. I would then like to paste this data into the sheet "Slide 1".

It's a little difficult to explain, so I have attached a file, showing the raw data on the "Monthly Projects" sheet, sheet "Slide 1" where I would like to paste the data to, and sheet "Slide 1 Expected Outcome" displaying how I would like, if at all possible the extracted data to look.

I have to admit I'm not even sure where to start, and I've been unable to find post/examples which perform the data extraction within a loop.

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

ir121973 · Oct 18th 2013

Re: VBA Insert Row and Subtotal

HI royUK, thank you very much for taking the time to reply to my post and for the guidance.

Kind Regards

ir121973 · Oct 18th 2013

Re: VBA Insert Row and Subtotal

Hi cytop, thank you for taking the time to reply.

Yes, you're quite right, but I was hoping to keep manual intervention to a minimum for the project I'm working on because some of the staff who will be using this, have a very, very limited knowledge of Excel.

Many thanks and kind regards

ir121973 · Oct 18th 2013

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

I have a dynamic sorted list, ranging from columns B:F with headers in row 4 and the data starts in row 5, and I'm trying to put together a script which performs the following:

Look for each change in column C ,
Where this occurs insert a new row below, and insert the text "Subtotal for (then the text value of the group)" in column C, and
Then sum the values in columns D, E and F

I've spent quite a bit of time researching this and I came across the following example http://www.mrexcel.com/forum/e…h-change-sorted-list.html

and I've tried to use the following code from this post, but I've been unable to get this to work:

Code

Sub SplitListAndSubTotal()
'
' SplitListAndSubTotal Macro
' Macro recorded 19/03/2004 by GaryB
'
Dim myRow As Long
Dim MyStart As Long
 
MyStart = 2
myRow = 3   'or use 2 if you haven't got a header
 
Do Until Cells(myRow, 1) = ""
If Cells(myRow, 1) = Cells(myRow - 1, 1) Then
myRow = myRow + 1
Else
Cells(myRow, 1).EntireRow.Insert
Cells(myRow, 3) = Application.WorksheetFunction.Sum(Range(Cells(MyStart, 3), Cells(myRow - 1, 3)))
Cells(myRow + 1, 1).EntireRow.Insert
myRow = myRow + 3
MyStart = myRow - 1
 
End If
Loop
 
Cells(myRow, 3) = Application.WorksheetFunction.Sum(Range(Cells(MyStart, 3), Cells(myRow - 1, 3)))
 
 
'
End Sub

Display More

I just wondered whether someone may be able to look at this please and offer some guidanced om how I may be able to achieve this.

Many thanks and kind regards

ir121973 · Oct 17th 2013

Re: VBA Remove Characters

Hi jindon, thank you very much for your continued help with this. The code now works perfectly.

Many thanks and kindest regards