Hi Joel

This is Fantastic!! You have been an excellent help.
Possible to have a message box that show the numbers of items
process for each name such as :
"Total for files process AB : 9. MY : 2, and so on" ?

How could I get started to learn coding in macro? I have a few good books on
this subject but doesn't seem to be able to get started on this.

thank you very much on all the help you have given. Appreciate very much!

cheers, francis





"Joel" wrote:

I did some more testing and found some minor errors. He is the code that
should work exactly the way you asked for it.


Sub SaveToTemplet()

Folder = "F:\MyProcess\"

Set SourceSht = ActiveSheet

With SourceSht
RowCount = 2
Do While .Range("C" & RowCount) < ""
'get company name with employee name
CompName = .Range("C" & RowCount)
'seperate company name from employee
PersonName = Trim(Mid(CompName, InStr(CompName, " ") + 1))
CompName = Left(CompName, InStr(CompName, " ") - 1)
'add Ltd to Company name
CompName = CompName & " Ltd"

CompanyFolder = Folder & CompName & "\"
FNamePrefix = CompanyFolder & CompName

Version = 0
'Look for all versions of the file using the wild card *
FName = Dir(FNamePrefix & "*.xls")
If FName = "" Then
MsgBox ("No Files exists for Company : " & CompName)
Else
Do While FName < ""
'If filname contain a underscore it is a version 1
If InStr(FName, "_") 1 Then
'remove all character before and including underscore
NewVersion = Mid(FName, InStr(FName, "_") + 1)
'remove the .xls and covert string to number
NewVersion = Val(Left(NewVersion, InStr(NewVersion, ".") - 1))
Else
'no underscore in filename, then version is 1
NewVersion = 1
End If
If NewVersion Version Then
Version = NewVersion
End If
FName = Dir()
Loop
If Version = 1 Then
Set Templet = Workbooks.Open( _
Filename:=CompanyFolder & CompName & ".xls")
Else
Set Templet = Workbooks.Open( _
Filename:=CompanyFolder & _
CompName & "_" & Version & ".xls")
End If
Set TempletSht = Templet.Sheets(CompName & " " & PersonName)

TempletSht.Range("B13") = .Range("C" & RowCount).Value
TempletSht.Range("B12") = .Range("G" & RowCount).Value
TempletSht.Range("B20") = .Range("F" & RowCount).Value
TempletSht.Range("B41") = .Range("J" & RowCount).Value
TempletSht.Range("B42") = .Range("A" & RowCount).Value
TempletSht.Range("B17") = .Range("O" & RowCount).Value

'save the file at the next higher revision number
Templet.SaveAs Filename:= _
CompanyFolder & CompName & "_" & _
(Version + 1) & ".xls"
Templet.Close savechanges:=False

RowCount = RowCount + 1
End If
Loop
End With

End Sub


"Joel" wrote:

I keep on missing things. This has a few improvements and corrections

Sub SaveToTemplet()

Folder = "F:\MyProcess\"
Set SourceSht = ActiveSheet

With SourceSht
RowCount = 2
Do While .Range("C" & RowCount) < ""
'get company name with employee name
CompName = .Range("C" & RowCount)
'seperate company name from employee
PersonName = Trim(Mid(CompName, InStr(CompName, " ") + 1))
CompName = Left(CompName, InStr(CompName, " ") - 1)
'add Ltd to Company name
CompName = CompName & " Ltd"

CompanyFolder = Folder & CompName & "\"
FNamePrefix = CompanyFolder & CompName

Version = 0
'Look for all versions of the file using the wild card *
FName = Dir(FNamePrefix & "*.xls")
If FName = "" Then
MsgBox ("No Files exists for Company : " & CompName)
Else
Do While FName < ""
'If filname contain a underscore it is a version 1
If InStr(FName, "_") 1 Then
'remove all character before and including underscore
NewVersion = Mid(FName, InStr(FName, "_") + 1)
'remove the .xls and covert string to number
Version = Val(Left(NewVersion, InStr(NewVersion, ".") - 1))
Else
'no underscore in filename, then version is 1
NewVersion = 1
End If
If NewVersion Version Then
Version = NewVersion
End If
FName = Dir()
Loop
If Version = 1 Then
Set Templet = Workbooks.Open(Filename:=CompanyFolder & CompName
& ".xls")
Else
Set Templet = Workbooks.Open(Filename:=CompanyFolder & CompName
& "_" & Version & ".xls")
End If
Set TempletSht = Templet.Sheets(CompName & " " & PersonName)

TempletSht.Range("B13") = .Range("C" & RowCount).Value
TempletSht.Range("B12") = .Range("G" & RowCount).Value
TempletSht.Range("B20") = .Range("F" & RowCount).Value
TempletSht.Range("B41") = .Range("J" & RowCount).Value
TempletSht.Range("B42") = .Range("A" & RowCount).Value
TempletSht.Range("B17") = .Range("O" & RowCount).Value

'save the file at the next higher revision number
Templet.SaveAs Filename:=CompanyFolder & CompName & "_" & (Version
+ 1) & ".xls"
Templet.Close savechanges:=False

RowCount = RowCount + 1
End If
Loop
End With

End Sub


"franciz" wrote:

Hi Joel

This is great! thank you very much for your help.

Is it possible to create additional templates based on the last used
template of
the same name?
Currently the macro copy the data to the destinated cells of the templates
and the
last copied data remain there which will wipe out the earlier copied data.

As on some days, there more than one instances of the same name in column C,
eg C2,C6,C9 have the value "AB John". The templates will show the last copied
data in the template for C9 for the case of "AB John". I need all the copied
data to remain in the templates for printing, hence the need to create
additional templates by copying the template of "AB John" and add it to the
workbook if need.

Thanks

regards, francis

"Joel" wrote:

The sheet name isn't in the workbook. Add this message box to help find
problem

MsgBox ("workbookName = " & CompName & ".xls" & Chr(10) & _
" Sheet Name : " & CompName & " " & PersonName)
Set TempletSht = templet.Sheets(CompName & " " & personName)

"franciz" wrote:

Hi Joel

Thank you very much for your effort. The macro produced an error message
" Run time error '9' : Subscript out of range " with this line highlighted

Set TempletSht = templet.Sheets(CompName & " " & personName)

thanks

regards, francis



"Joel" wrote:

found one more error. don't know why excel didn't give me an error

from
Set templet = Workbooks.Open(Filename:=Folder & _
CompName & "\" & CompName.xls)
Set templet = Workbooks.Open(Filename:=Folder & _
CompName & "\" & CompName & ".xls")

"franciz" wrote:

Hi Joel

Thanks, it does copy correctly the value to the cells on sheet template.

However, is it possible for the macro to look at the next row and repeat the
same until the last empty cell in column C?

thank for your help in this.

regards, francis



"Joel" wrote:

Try replaceing the copy statement with this code. This will not copy the
format. If you neeed formats I'll need to use pastespecial.

TempletSht.Range("B13") = .Range("C2").value
TempletSht.Range("B12") = .Range("G2").value
TempletSht.Range("B20") = .Range("F2").value
TempletSht.Range("B41") = .Range("J2").value
TempletSht.Range("B42") = .Range("A2").value
TempletSht.Range("B17") = .Range("O2").value



"franciz" wrote:

Hi Joel

The macro does copy specific data to the sheet template except for B17which
give the result of #Ref, I believe this is due to the formula in column O
=F2/N2 in B17

Is it possible to have the macro look at column C and go to the specific
folders and get the sheet in the file which named the same as column C?

1) all the specific folders are saved in F:\MyProcess\xxxxx
where xxxxx is the folders' name that I need to access the files based on
the first 2 or 3 characters in column C of the working sheet

Eg. C2 have the value of ABC John
C3 have the value of ABC Mary
C4 have the value of NYC Maria

can the macro
1) open the sheet "ABC John" which it does now and copy the data and after
it is done
2) move to C3 and open the next sheet template which have "ABC Mary" under
"ABC Ltd" and copy the data.
3) then move to C4 and open NYC folder, look for "NYC Maria" and open it.
copy the
data to the sheet template of "NYC Maria"

thank you very much for assisting in this, I appreciate your effort very much

regards, francis




"Joel" wrote:

You also need to change the Folder to the folder you are using.

"franciz" wrote:

Hi Joel

Thanks for looking into this.
It give me an error message Run time error "1004"
" cannot access to "ABC Ltd", the document may be read-only or encrypted
with line highlighted :

Set templet = Workbooks.Open(Filename:=Folder & CompName)

I have check the workbook and it was not protected, both the path and the
files are
in the correct place.

Not sure where did this goes wrong.

regards, francis

"Joel" wrote:

change folder name as required