Divinedar 12

So if the QTY is blank I need for it to add a "1" in cells D15 and a "1" in cells E15 only in the NEWSHT if QTY is blank in the WBS_Items worksheet.

Divinedar 12

Within the main WBS_Items worksheet there are items with blank Qtys' which has a tendency to cause an error. I need for the ones that are blank to be included but without error if possible. You'll understand once you run the code. The main menu is in ADD-INS.

Divinedar 12

Thank you Reverend Jim. The code is in Module 2.

Divinedar 12

xrjf sorry for the delay in responding but we shut down during the holidays. I've tried once before to attach an attachment to this but it doesn't seem to let me. I'm going to try again and the main code is in Module 2. Let me know what you find out . I just can't get it to stop when it reaches the last line on the list. It errors out.

Divinedar 12

My biggest problem I get to one line in the code and I get a Run-time error '1004' so I believe it putting that piece of code in the right place for it to get exit the loop after the last row in the column of the LASTROW. So not sure where to put it.

 Sheets("Newsht").Name = MyRange.Cells(i, 1) ' renames the new worksheet

Divinedar 12

So do you mean instead of using .End(xlUp).Row use .UsedRange?

Divinedar 12 Newbie Poster

I have a worksheet of about 388 items that each item is exported into a template worksheet that is created to itemize each item. It creates the worksheets but I can't get it to stop looping at the line of code in bold comments icons. The line that it stops at is to name the worksheet from the column "A" of the list of 388. I have shorten the list to work on the code. So when I'm done I would have workbook of 388 worksheets from the template made. The template worksheet name is "wbs_template" (hidden). I have attached an example of the workbook.

My other issue is that my IF STATEMENT is skipping lines if I use "1" in it. But if I change it to any other number it creates a wbs item for each item in the worksheet and I can't figure that out either.

Someone please help.

"Sub RenameNewSheet()

    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Dim MyCell As Range, MyRange As Range, wsSource As Worksheet, i As Integer, MyDate, Lastrow As Integer, Newsht As String

    Set MyRange = Worksheets("WBS_Items").Range("tableinfo")
    Set MyCell = Worksheets("WBS_Items").Range("WBSNUM")

    Set wsSource = Worksheets("WBS_Items")

    Lastrow = wsSource.Cells(Rows.Count, 1).End(xlUp).Row

    wsSource.Range("A9:Q" & Lastrow).Select

    For Each MyCell In MyRange
    For i = 1 To Lastrow
    Cells(i, 1).Select

    If Cells(i, 1).Value <= 1 Then

            Worksheets("wbs_template").Visible = True
            Sheets("wbs_template").Select
            Sheets("wbs_template").Copy before:=Sheets("Rates")
            Worksheets("wbs_template").Visible = False
            Sheets("wbs_template (2)").Select
            Sheets("wbs_template (2)").Name = "Newsht"
            Sheets("Newsht").Activate
            Range("N8").Value = MyRange.Cells(i, 1) 'Adds WBS Number from column A
            Range("E8").Value = Sheets("PROJECT_INFORMATION").Range("A2") ...

Divinedar 12

Ok so I wrote my own code which works pretty good but I know it can be less steps in the process.

Sub RenameNewSheet()
    Dim MyCell As Range, MyRange As Range, MyRange1, MyRange2, MyRange3, MyRange4, MyRange5, MyRange6, MyRange7, MyRange8, MyRange9
    Dim wsSource As Worksheet

    'This Macro will create separate tabs based on a list in Distribution Tab A2 down

    Worksheets("WBS_Items").Select

    'Column A WBS No
    Set MyRange = Sheets("WBS_Items").Range("A9")
    Set MyRange = Range(MyRange, MyRange.End(xlDown))

    'Column B Part No
    Set MyRange1 = Sheets("WBS_Items").Range("Partno")
    Set MyRange1 = Range(MyRange1, MyRange1.End(xlDown))

    'Column C Description
    Set MyRange2 = Sheets("WBS_Items").Range("Desc")
    Set MyRange2 = Range(MyRange2, MyRange2.End(xlDown))

    'Column D Qty
    Set MyRange3 = Sheets("WBS_Items").Range("QTY")
    Set MyRange3 = Range(MyRange3, MyRange3.End(xlDown))

    'Column E Each
    Set MyRange4 = Sheets("WBS_Items").Range("EachAmt")
    Set MyRange4 = Range(MyRange4, MyRange4.End(xlDown))

    'Column G Material Cost1
    Set MyRange5 = Sheets("WBS_Items").Range("MATCOST")
    Set MyRange5 = Range(MyRange5, MyRange5.End(xlDown))

    'Column J Material Cost Freight Estimate
    Set MyRange6 = Sheets("WBS_Items").Range("MTLFRGT")
    Set MyRange6 = Range(MyRange6, MyRange6.End(xlDown))

    'Column X Quality Labor Hours
    Set MyRange7 = Sheets("WBS_Items").Range("X13")

    'Column X Assembly Wireman Labor Hours
    Set MyRange8 = Sheets("WBS_Items").Range("X15")

    'Column M Material and Labor markup %
    Set MyRange9 = Sheets("WBS_Items").Range("X15")

    Dim MyDate

    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    For Each MyCell In MyRange

'        Sheets.Add After:=Sheets(Sheets.Count) 'creates a new worksheet
        copy_template
            Sheets("Newsht").Activate
            Sheets("Newsht").Cells(23, 6) = "1"
            Range("E8").Value = Sheets("PROJECT_INFORMATION").Range("A2")
            MyDate = Sheets("PROJECT_INFORMATION").Range("G2")
            Range("G8").Value = MyDate
            Range("I8").Value = Sheets("PROJECT_INFORMATION").Range("D2")
            Range("A1").Select
            Sheets("Newsht").Cells(23, 6) = "0"

            applydata

            Sheets("Newsht").Select

            Sheets("Newsht").Name = MyCell.Value ' renames the new worksheet

            Range("N8").Value = MyCell.Value 'add wbs no to worksheet

            Range("A1").Select

   Next MyCell

HideSheets

    RebuildSell
    Application.Calculation ...

Divinedar 12 Newbie Poster

Ok I have a a list of about 392 items that needs to be put into an excel form. I manage to get Column A (which is the inserted worksheet names) to name the worksheets that is automatically inserted.

I have attached an example of my table

When the code names names the see it also puts that same name in cell "N8"

From the table I also need for the code to put in the information from that same line to insert various cells from the table. When you look at the attachment the columns that is highlighted in row 2.

The code is in MODULE 2 of the attached file.

Let me know if you need anything else.

Divinedar 12 Newbie Poster

I need to take a video posted on youtube that was once a powerpoint and convert back to a powerpoint and print. I can't seem to find a converter for mp4 to ppt, i.e., that would work once I have the video download. Obviously there has to be a free software out there somewhere that can do this. Anyone know of one?

Divinedar 12

I'm still having this problem and has received no help. To reinterate my issue again I can't get my heading 1 in the Table of Contents. My layout for my page numbering is as follows:

STYLEREF "Heading 1" \n \t * MERGEFORMAT - PAGE * Arabic * MERGEFORMAT

Works great on the page number just won't include the heading 1 part in my table of contents. Can anyone help me?

Divinedar 12 Newbie Poster

I have a document that include the chapter numbers in the page numbering, but when I run the table of content I can't get it to include the chapter numbers with the page numbering in the table of content. Also the first 17 pages of the table of content is roman numerals and they dont appear either. I have microsoft word 2010. How can I correct this? I have tried the switches within the table of contents of that's not working either. HELP!!! This is a 300 page document and I would hate to have to do the TOC manually.

Divinedar 12

ok so I had to change

Do While Sheet1.Range(TargetCell).Value <> ""

to

Do While Sheet80.Range(TargetCell).Value = ""

for it to go to the next line.

But when I get here

FindValue = SourceSheet.Range(SourceCell)

I get a "runtime error 91 object variable or With block variable not set"

Divinedar 12

Ok thanks for the code but I'm confused between the target sheet and source sheet. It doesn't get pass this part of the code:

     Set TargetSheet = Sheet80
    TargetRow = 3
    TargetCell = "A" & CStr(TargetRow)
    Do While Sheet80.Range(TargetCell).Value <> ""

Let me see if I understand this right. The TargetSheet is the sheet where the all the information collected will go and the SourceSheet are all the worksheets within the workbook?

I've attached 2 sheets in a pdf one is a targetsheet and a sourcesheet to give you an idea of what I'm working with. All the sourcesheets are in the same format.

Divinedar 12

It could be many project numbers so doing a case statement won't work, to many.

Divinedar 12

OK you just about got it right but I want to do he project number and not the employee. If the code cycles through the sheets sometime the project number on several sheets. I want just want the project number and the sum of the number of hours.

If it goes to the next sheet and that same project number exist just add the hours i.e.;

Worksheet 1 (This is just the information I need out of each worksheet)
Task/Account Total Hours

 P12065     38
 P13017     58

Worksheet 2 (This is just the information I need out of each worksheet)
Task/Account Total Hours

P12065    38
 P13017     58
 P12035     10

Calculate Worksheet
Task/Account Total Hours

 P09998     53
 P13017     75
 P12035     10

So it also adds any project number that is not on the list.

Divinedar 12 Newbie Poster

I have several worksheets that list the following data on each sheet but different project number:

A B C D E F G
Date Hours Project Description Task/Account Comments Employee Hours Total
Aug-19 4.00 P09998 BID&PROPOSAL PRE-PREPOS P09998 Mexico iDirect; James 34.00
Aug-20 4.00 P09998 BID&PROPOSAL PRE-PREPOS P09998 Staff Meeting, James
Aug-21 8.00 P09998 BID&PROPOSAL PRE-PREPOS P09998 MTTS & TCT Drawings James
Aug-22 8.00 P09998 BID&PROPOSAL PRE-PREPOS P09998 MTTS/TCT Drawings James
Aug-23 8.00 P09998 BID&PROPOSAL PRE-PREPOS P09998 MTTS/TCT Drawing James
Aug-19 2.00 P09998 BID&PROPOSAL PRE-PREPOS P09998 Research and John

Aug-21 2.00 P13017-TELESAT RFI/ROM CISCEA P13017 Richard 13.00
Aug-22 3.00 P13017-TELESAT RFI/ROM CISCEA P13017 Richard
Aug-19 4.00 P13017-TELESAT RFI/ROM CISCEA P13017 James
Aug-20 4.00 P13017-TELESAT RFI/ROM CISCEA P13017 James

All the sheets within the workbook has the same layout as above.

What I want to do is gather information from each sheet in the following format into one worksheet

Task/Account Total Hours
P09998 34
P13017 13
etc...

I need the code to go through each sheet and if that Task/Account already exist within the main sheet (calculating sheet) then just add the hours to what is already there.

Such as:

Date Hours Project Description Task/Account Employee Hours Total
Aug-14 4.00 P09998 BID&PROPOSAL PRE-PREPOS P09998 Richard 4.00

Aug-12 8.00 P13017-TELESAT RFI/ROM CISCEA P13017 Richard 45.00
Aug-13 8.00 P13017-TELESAT RFI/ROM CISCEA P13017 Richard
Aug-14 4.00 P13017-TELESAT RFI/ROM CISCEA P13017 Richard
Aug-15 8.00 P13017-TELESAT RFI/ROM CISCEA P13017 Richard
Aug-16 8.00 P13017-TELESAT RFI/ROM CISCEA P13017 Richard
Aug-14 5.00 P13017-TELESAT RFI/ROM CISCEA P13017 James
Aug-15 4.00 ...

Divinedar 12

Can I get some help from someone. I have also asked for help at the following location:

http://database.ittoolbox.com/groups/technical-functional/excel-l/add-path-and-filename-hyperlink-5032211#M5145673

Divinedar 12

Also I want to know how do I write this line for any type of document that maybe in the folder? Not just doc file, but txt, xml or any type of file that is in the folder.

Optional WithExt As String = "doc")

Divinedar 12 Newbie Poster

Can anyone help. I have the following code:

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column = 7 Then
MakeHyperLink Target, "Q:\"

End If

End Sub

Option Explicit
Private Files As Dictionary
Private StrFile As String
Dim StrFlePath As String, FleCollection, fle, f1, fs, f2, subfld
Sub MakeHyperLink(InRange As Range, _
ToFolder As String, _
Optional InSheet As Worksheet, _
Optional WithExt As String = "doc")
Dim rng As Range
Dim Filename As String
Dim Ext As String

With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With

If Files Is Nothing Then
GetFileAddress
End If

'check to see if folder has trailing \
If Right(ToFolder, 1) <> "\" Then
Filename = ToFolder & "\"
Else
Filename = ToFolder
End If
'check to see if need ext
If WithExt <> "" Then
'check to see if ext has leading dot
If Left(WithExt, 1) <> "." Then
WithExt = "." & WithExt
End If

End If
'if not explicit sheet then assign active
If InSheet Is Nothing Then
Set InSheet = ActiveSheet
End If
'now for every cell in range
For Each rng In InRange
'does range have value
If rng <> "" Then
'make hyperlink to file
StrFlePath = Files(UCase(rng.Text & WithExt))

InSheet.Hyperlinks.Add Anchor:=rng, Address:= _
StrFlePath, TextToDisplay:=rng.Text

End If

Next

With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With

End Sub
Sub GetFileAddress()
Set Files = New Dictionary
FindFolder "Q:\"
End Sub
Sub FindFolder(strPath As String)
Set fs = CreateObject("scripting.filesystemobject")
Set f1 ...

Divinedar 12

Okay I'm still working on this and can't seem to get it to work properly. It's not that it's not working, it's slow and I need to search and replace some hyperlinks because when you close the workbook, you loose the links.

This is what I have that works but it's slow because there are subfolders and plenty files:

Private Sub Worksheet_Change(ByVal Target As Range)
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With

If Target.Column = 7 Then
MakeHyperLink Target, "Q:\"
End If

    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
    End With

End Sub

Option Explicit
Private Files As Dictionary
Private StrFile As String
Dim StrFlePath As String, FleCollection, fle, f1
Public Function MakeHyperLink(InRange As Range, _
ToFolder As String, _
Optional InSheet As Worksheet, _
Optional WithExt As String = "doc") As String
Dim Rng As Range
Dim Filename As String
Dim Ext As String

    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With

GetFileAddress
'check to see if folder has trailing \
If Right(ToFolder, 1) <> "\" Then
Filename = ToFolder & "\"
Else
Filename = ToFolder
End If
'check to see if need ext
If WithExt <> "" Then
'check to see if ext has leading dot
If Left(WithExt, 1) <> "." Then
WithExt = "." & WithExt
End If

End If
'if not explicit sheet then assign active
If InSheet Is Nothing Then
Set InSheet = ActiveSheet
End If
'now for every cell ...

Divinedar 12

OK I understand that but where would it fit in the code. Not sure I understand that part.

Since I'm looking for the cell I assume it goes here:

Sub AddHyperlinks(ByVal f2 As Folder)
    For Each fil In f2.Files
    'If the string matches add the hyperlink
    If InStr(1, fil.Name, TargetCell.Text) > 0 Then
       Worksheets(1).Hyperlinks.Add Anchor:=Hyprlinks.Cells(Counter), Address:=fil.Path
       'Increment to the next cell
       Counter = Counter + 1
    End If
    Next
End Sub

I know it works with this
InStr(1, fil.Name, TargetCell.Text)
cause this is where I'm having the problem with the 1.

Divinedar 12

It works but it hyperlinks to the first cell of the column only, it doesn't find the cell that I'm typing the filename in. So I'm guessing this line InStr(1, fil.Name, TargetCell.Text), which is only row 1, so how do I get it to count to the row and cell that I'm typing in?

Divinedar 12

If it's fine where it is how do I use it in my code? Also, no Application.FileSearch does not work in 2010. I think it said that you would have to Dir().

Divinedar 12

I think my problem is I don't know where to put o_strFileName = strPath(lngIndex-1), not sure I understand. I have 2010 Excel and FileSearch doesn't work.

This is the first one I'm working on:
Test_Log

This is another of the illustrations:
CCB

Let me know if you need anything else that may help.

Divinedar 12

Click Here

I'm also trying to get help from the aforementioned website. I just can't seem to get this right and I need help as soon as possible.

Please read the above link and see if anyone can help me please.

Divinedar 12

How about this would this work:

Public Function SeparatePathAndFile(ByRef io_strFolderPath As String, ByRef o_strFileName As String)
    Dim strPath() As String
    Dim lngIndex As Long

    o_strFileName = "*FR*.doc"

    strPath() = Split(io_strFolderPath, "\")  'Put the Parts of our path into an array
    lngIndex = UBound(strPath)
    o_strFileName = strPath(lngIndex)   'Get the File Name from our array
    strPath(lngIndex) = ""              'Remove the File Name from our array
    io_strFolderPath = Join(strPath, "\")     'Rebuild our path from our array
End Function

This seems to work somewhat, just can't get it to do the filename.

Divinedar 12

Okay NO that's not what I need. What I need to do is when I type the file name in a cell, i.e., "FR 2011", it searches for the file in a directory and in subfolders for the file name and hyperlink to that file as the name is typed in. Without the Recursive code it works fine but it doesn't search the subfolders and I need it to search the subfolders.

Divinedar 12

Okay now I have the following that may seem to work. I'm having a reference issue I believe that's keeping it from working. Can you help? I'm trying to search subfolders within the directory with this filename wildcard FR.doc.

Public Function MakeHyperLink(InRange As Range, _
ToFolder As String, _
Optional InSheet As Worksheet, _
Optional WithExt As String = "doc") As String
Dim rng As Range
Dim Filename As String
Dim Ext As String

    Dim objFSO As FileSystemObject
    Dim FileCnt As Long

     'Create an instance of the FileSystemObject
    Set objFSO = CreateObject("Scripting.FileSystemObject")

'check to see if folder has trailing \
If Right(ToFolder, 1) <> "\" Then
Filename = ToFolder & "\"
Else
Filename = ToFolder
End If
'check to see if need ext
If WithExt <> "" Then
'check to see if ext has leading dot
If Left(WithExt, 1) <> "." Then
WithExt = "." & WithExt
End If

End If
'if not explicit sheet then assign active
If InSheet Is Nothing Then
Set InSheet = ActiveSheet
End If
'now for every cell in range
For Each rng In InRange
'does range have value
If rng <> "" Then
'make hyperlink to file
InSheet.Hyperlinks.Add Anchor:=rng, Address:= _
        RecursiveFolder(objFSO, "Z:\", True, FileCnt), TextToDisplay:=rng.Text
End If

Next

End Function

Sub RecursiveFolder( _
    FSO As FileSystemObject, _
    MyPath As String, _
    IncludeSubFolders As Boolean, _
    Cnt As Long)

     'Declare the variables
    Dim File As File
    Dim Folder As Folder
    Dim SubFolder As Folder

     'Get the folder
    Set Folder = FSO.GetFolder(MyPath)

     'Loop through each ...

Divinedar 12

Sorry another question:

Say I wanted to use the text in column A as a search for the GetFullPath, do I have to verify that in anyway in the code to search for the string in column A?