Posts by mrfitness

Hi Tom,
Thank you for the update. I revised the summary a bit to fit my bosses needs, but ran into an issue when I tried my first order. Basically some job #s have length quantities greater than 1, so I broke out the quantity into duplicate rows (ie Qty 2 of length 6071 would break out into 2 rows of 6071). Therefore if I delete the code that removes duplicates it would work. Is there any harm in removing that section?:

' Remove the duplicate combinations.
wsBestCombinations.Columns("A:A").Select
wsBestCombinations.Range("A1:C" & LastRow(wsBestCombinations, 1)).RemoveDuplicates Columns:=1, Header:=xlYes

Also, in the attached file, I ran the code with the job #. Is there any easy way to group the 'order combination' tab so that duplicate order combinations & job#s show up as one light with a quantity?

Hey Tom
I am using Windows 7, Excel 2013
I did remove the X but it was sometimes failing at line

wsOrder.Sort.SortFields.Add2 Key:=Range("B1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

I would just close the book, not save it, reopen and run it again and it would be fine.

I am still sorting through your code to figure out how you determine if rngFoundCell is not nothing (blnCombinationMatched = True in essence).I am decent with arrays but the ranges not so much.

I figure at that point in the loop I could have used the information you put in a comment box to put in cells in a column (and then delete those values if blnCombinationMatched = False). Unless I do it after the loop before the sort?

Tom I have attached a summary to easily see what I am talking about as it may not be super clear above. Thanks again

Tom you are a gentleman and a scholar! I tried re-running the code an got an error on the sorting, but I can try to figure that out myself.

One thing I failed to mention which I did not think was important at the time was that each row of material order has an identifier related to the job the piece is needed for. So when I give my boss the best combinations he wants to know which job the pieces are related to. [TABLE="border: 0, cellpadding: 0, cellspacing: 0"]

[TD="width: 64"]job#[/TD]
[TD="width: 64"]length[/TD]

r1

[TD="width: 64"]2254[/TD]

r4 r5 r3

[TD="width: 64"]3694[/TD]

r6

[TD="width: 64"]2254[/TD]

r7

[TD="width: 64"]3225[/TD]

r7

[TD="width: 64"]3225[/TD]

r8

[TD="width: 64"]3131[/TD]

r9

[TD="width: 64"]2254[/TD]

r9

[TD="width: 64"]2254[/TD]

r10

[TD="width: 64"]1174[/TD]

r10

[TD="width: 64"]1174[/TD]

r10

[TD="width: 64"]1174[/TD]

r10

[TD="width: 64"]1174[/TD]

r10

[TD="width: 64"]1174[/TD]

r10

[TD="width: 64"]1174[/TD]

r11

[TD="width: 64"]3225[/TD]

r11

[TD="width: 64"]3225[/TD]

r12

[TD="width: 64"]3131[/TD]

r13

[TD="width: 64"]2254[/TD]

r15

[TD="width: 64"]4402[/TD]

r15

[TD="width: 64"]4402[/TD]

r15

[TD="width: 64"]4402[/TD]

r16

[TD="width: 64"]2253[/TD]

[/TABLE]

Currently the best combination is put in a comment box (Combination: [3225] [4402] [2254] [2254]), but how would I be able to have that data listed in a cell with the job# included (ie Combination: [3225] [4402] [2254] [2254] r7, r15, r1, r6) or one column for length combination and one column for job #?

Any ideas from anyone out there?

My company makes pieces of tubing from our standard stock lengths of 20ft, 40ft and 60ft. We get a daily order request of tubing pieces of different lengths (less than 20ft) and my job is to figure out what combination of individual pieces can be combined to make up a stock piece with minimal waste (we ideally want to use 40ft stock length tubing to cut up for orders as it is easy to handle.)

I have a numeric list that represent lengths of piece order (in mm). The number of pieces in the order changes all the time. I need to find the combination of numbers that comes closest to 12,192mm (40ft). Then once I find that, I need to discard those piece orders (as they have been used to make up a stock piece) and then I need to find the next combination, etc until all pieces in the order have been accounted for. If there is a great deal of waste (ie more than 15%) the combination is not ideal and I would want to try to fit pieces to 18,288mm (60ft) or 6,096mm (20ft)

For example the list below is an order, each row is a piece order request in mm [TABLE="border: 0, cellpadding: 0, cellspacing: 0"]

[TD="width: 64, align: right"]2254[/TD]

[TD="align: right"]3694[/TD]

[TD="align: right"]2254[/TD]

[TD="align: right"]3131[/TD]

[TD="align: right"]3131[/TD]

[TD="align: right"]2254[/TD]

[TD="align: right"]2253[/TD]

[TD="align: right"]3225[/TD]

[TD="align: right"]2254[/TD]

[TD="align: right"]3225[/TD]

[TD="align: right"]4402[/TD]

[TD="align: right"]1174[/TD]

[TD="align: right"]1174[/TD]

[TD="align: right"]1174[/TD]

[TD="align: right"]1174[/TD]

[TD="align: right"]1174[/TD]

[TD="align: right"]1174[/TD]

[TD="align: right"]3225[/TD]

[TD="align: right"]2254[/TD]

[TD="align: right"]3225[/TD]

[TD="align: right"]4402[/TD]

[TD="align: right"]4402[/TD]

[/TABLE]

I could get these broken out into the following groupings: [TABLE="border: 0, cellpadding: 0, cellspacing: 0"]

[TD="width: 76"]ACTUAL LENGTH[/TD]
[TD="width: 329"]Combinations used from list above[/TD]

[TD="align: right"]11333 > [/TD]

2254, 3694, 2254,3131

[TD="align: right"]11552 > [/TD]

2254,2254,1174,1174,1174,1174,1174,1174

[TD="align: right"]11835 > [/TD]

3225,3131,2254

[TD="align: right"]11057 > [/TD]

4402,4402,2253

[TD="align: right"]10852 > [/TD]

3225,3225,4402

[/TABLE]

I tried using the SOLVER add-in but couldn't get it to work so wondering if there is another way or in vb script to find what I need it to do?

So after a few hours I finally was able to figure it out. Here is what I did:
Open a new excel instance
From there I click browse to get to the file, and I hold down the shift button and open file
When "enable macros?" screen comes up I disable macros.
I do NOT enable content (yellow bar at top). I go to vb code screen and write in Stop in first line of workbook open procedure
I save and close the file then reopen it normally and enable content. The code will take me to the Stop line in workbook open. I stop the code and remove the 'Stop' line in workbook open procedure. I save the file, close and reopen
Now all my coding in all modules appear!
I hope this will help someone else should they come across this weird issue

I was unable to find someone with the same issue so I am posting it here in case it happens to anyone else.
It appears something happen to a saved excel file because when I open the file it says "Cant find project or library" but after pressing OK I open to the vb window and I can see all my modules listed. However when I try to click on any module or worksheet to see the code all that comes up is an empty white box (no code). See attached 'no vb showing' image of what I mean. Note there is no option to compile code either.
Then when I close the file it says the missing library message again and excel crashes (see excel stop working file attached)
I will continue to try and find a solution, just wondering if this has happened to anyone else?
Thanks!

Is it possible in vba to close the current workbook you are using without saving changes, re-open it, update a cell value, then close that workbook this time saving changes?

I had code that worked, but when I tried it again in another workbook it would close the first time, terminating the code.

Dim obook As Workbook
Dim varTCMasterWorkbook




varTCMasterWorkbook = ActiveWorkbook.Name 'master workbook name                
'does stuff
obook.Close Savechanges:=false
                
                Set obook = Nothing
                Set obook = Application.Workbooks.Open("C:\" & varTCMasterWorkbook)
                Application.DisplayAlerts = True


Dim s_counter, c_counter
    'add a submission counter to the summary and custom summary pages to keep track of multiple submissions for one profile
    Worksheets("Summary").Unprotect
    s_counter = Worksheets("Summary").Range("B2").Value + 1
    Worksheets("Summary").Range("B2").Value = s_counter
    Worksheets("Summary").Protect
    Worksheets("Summary").Visible = False
    
    Worksheets("Custom Summary").Unprotect
    c_counter = Worksheets("Custom Summary").Range("B2").Value + 1
    Worksheets("Custom Summary").Range("B2").Value = c_counter
    Worksheets("custom summary").Range("E1").Value = "Exception/Custom Request"
    Worksheets("Custom Summary").Protect


thisworkbook.close Savechanges:=true

I am using redemption code vba to send emails in my excel application (apparently a safer way to email using vba)

The code is intended for users and therefore the emails would be sent by the code instead of the user (to avoid any tampering, etc by the user with sensitive information in the email)

The main issue I am having is getting the excel vba code to resolve email names/groups without having the Outlook security warning pop up, as well as the issue of having the email get sent before the names/groups are resolved (which causes Error Number: -2147418113: "Could not resolve the message recipients" - even though the address is legitimate).

I have simplified my code and hard coded my email variables for this example, using fake addresses instead of group names. I also replaced the .SEND command with the .DISPLAY command to view if the addresses have been resolved or not. In actuality the email addresses will be different group names that, if not resolved, would cause an error when sending with the .SEND command. (as noted in the previous paragraph)

Sub email()
Dim OL_App As Object
Dim OL_item As Object
Dim namespace
Dim SafeItem, oItem, ccRecip
 
Set OL_App = CreateObject("Outlook.Application")
Set ol_item = OL_App.CreateItem(0) 'Create a new message
 
Set namespace = OL_App.GetNamespace("MAPI")
namespace.Logon
 
Set SafeItem = CreateObject("Redemption.safeMailItem")
 
SafeItem.Item = ol_item 'set Item property
 
strTo = "[email protected]; [email protected]" 'these would actually be a group name
StrCC = "[email protected]; [email protected]" 'these would actually be a group name
strBody = "testing it out"
strSubject = "Will it do it?"
 
With SafeItem.Item
         .Subject = strSubject
         .To = strTo
         .CC = StrCC
         .Body = strBody
         .Recipients.ResolveAll  'security msg pops up from this line!!!!
         .Display
         
End With
 
Set OL_App = Nothing
Set SafeItem = Nothing
 
End Sub

However, If i change the "With SafeItem.Item" statement to "With SafeItem" only (removing the ".Item" at the end), the email does display but it does not seem to be resolving, hence no security pop up appears. ("SafeItem.Recipients.ResolveAll" does not seem to be doing anything actually.)

How can I resolve the addresses without getting the outlook warning?[hr]*[/hr] Auto Merged Post Until 24 Hrs Passes;[dl]*[/dl]Ok I figured out how to do it so im posting the answer here for anyone else who is having this problem, as it took me a LOT of trial and error.

In my example, I have the addresses to email on "sheet1" of the workbook. The TO line addressess are in cell A1, and the CC line addresses are in cell A2. I have semi colons (";") seperating the email address names/groups, without spaces. (You could use cell A3 for email subject and cell A4 for email body but I chose not to in this example)

ie cell A1 is [email protected];[email protected] (could also be a group name- ie "forum_group")

You can have as many email addresses as you want in either cell A1 or A2, as I have a loop that uses Instr() function and ubound() to add each one.

Sub worksforCC()
Dim SafeItem, oItem
Dim OL_App As Object
Dim OL_item As Object
Dim namespace
Dim arrTORecipients() As String
Dim arrCCRecipients() As String


Set OL_App = CreateObject("Outlook.Application")
Set OL_item = OL_App.CreateItem(0) 'Create a new message


Set namespace = OL_App.GetNamespace("MAPI")
namespace.Logon


Set SafeItem = CreateObject("Redemption.SafeMailItem")


Set oItem = OL_App.CreateItem(0)


SafeItem.Item = oItem


strTo = Worksheets("Sheet1").Range("A1").Value
StrCC = Worksheets("Sheet1").Range("A2").Value


If InStr(strTo, ";") > 0 Then
arrTORecipients() = Split(strTo, ";")
i = 0
 For i = 0 To UBound(arrTORecipients)
 'add all the recipients to TO list
    SafeItem.Recipients.Add (arrTORecipients(i))
 Next i
     Else
    'just one recipient
    SafeItem.Recipients.Add (arrCCRecipients(i))
End If


If InStr(StrCC, ";") > 0 Then
arrCCRecipients() = Split(StrCC, ";")
j = 0
 For j = 0 To UBound(arrCCRecipients)
 'add all the recipients to CC list
    Set ccRecip = SafeItem.Recipients.Add(arrCCRecipients(j))
    ccRecip.Type = olCC
 Next j
 
    Else
    'just one recipient
    Set ccRecip = SafeItem.Recipients.Add(arrCCRecipients(j))
    ccRecip.Type = olCC
End If
 
SafeItem.Recipients.ResolveAll
SafeItem.Subject = "Testing Redemption"
SafeItem.Body = "Body Email"
SafeItem.Display


Set OL_App = Nothing
Set SafeItem = Nothing


End Sub

Quote from mrfitness

How can I resolve the addresses without getting the outlook warning?

Re: Error Log On Network For Multiple Users

Quote from Ger Plante

Use two machines and a shared out text file (on a network, or shared folder). On one machine, just step through your code (or my code) and when the text file is open, go to another machine and try and open that same text file for append again (same code, different machine, accessing the same file).
My bet is that it will crash again saying the file is already open.
Ger

Funny you mention that, I did test it out on 2 computers at the same time with the log file on the network. I ran the same code at the exact same time with the notepad open and did not receive any errors. When I closed notepad and re-opened it, both our logs were there! I did try this test many times, and I even put a toggle break on each of our VBA windows right before it writes to the log file and pressed the 'Play' button at the same time and it still worked.

Re: Error Log On Network For Multiple Users

Quote from Ger Plante

The Open statement will attempt to open the text file. If it is ALREADY open then the Open statment will fail (this is what I was showing you with my code above).

What I did to test was that I went on the network and opened the text file that the program writes to. Then I ran the program and thought I would get an error on the OPEN statement (as I had the text file opened) but it didn't error out at all (I even put in an error handler in the code)

Instead, after the program ran, I closed the text file, re-opened it, and it contained the new data just written from the program!

Please try doing a similar test on your computer with your code using "c:\test.txt", and remove the 2nd open statement in your code above. Let me know if you also do not get an error so I know I am not going crazy.

Thank you so much!

Re: Create Error Log On Network For Multiple Users

Quote from Ger Plante

So before your Open statement, you need an "on error resume next" statement and keep looping while the err.number = 55

Well doesn't this part of the code make sure it doesn't error on open:

FileNum = FreeFile ' next file number
    Open LogFileName For Append As #FileNum ' creates the file if it doesn't exist

So in essence the text file will open no matter what, but only one of the open files will save? Maybe I should change FileNum to a 1?

I am creating an error log as a text file for my application. Since it is being used by many different users, I decided to keep it logged in a specific folder (that is protected) on our network.
I have tested the code and it works, even if I have the log file open when I run the module, it still writes to the log file and saves (as long as I don't save the opened log file after the module runs)
What I am worried about is when 2 or more users are trying to write to the log file at the same time. I wanted to add something that checks if the file is open, and if it is, wait a second or two and then try to write to it again. Maybe try it a few times?

Below is my sample code.
Note that I am using the log creation in another module.

Sub datatopass()


LogInformation Worksheets("Email").Range("L2").Value & "|" & _
Application.UserName & "|" & _
Worksheets("Email").Range("M2").Value & "|" & _
Worksheets("Email").Range("N2").Value & "|" & _
"other things" 


end sub


'*******other module**************
Public LogFileName As String


Sub LogInformation(LogMessage As String)
'Const LogFileName As String = "\\n530fs1\PCLFileShares\pcl_reposit\Pricing_Tools\PAT\Security\" & Int(Now()) & "\PAT_APPROVALS.LOG"
Dim FileNum As Integer
Dim mdate
'get month in text
If Month(Int(Now())) = 1 Then
    mdate = "Jan"
    ElseIf Month(Int(Now())) = 2 Then
    mdate = "Feb"
    ElseIf Month(Int(Now())) = 3 Then
    mdate = "Mar"
    ElseIf Month(Int(Now())) = 4 Then
    mdate = "Apr"
    ElseIf Month(Int(Now())) = 5 Then
    mdate = "May"
    ElseIf Month(Int(Now())) = 6 Then
    mdate = "Jun"
    ElseIf Month(Int(Now())) = 7 Then
    mdate = "Jul"
    ElseIf Month(Int(Now())) = 8 Then
    mdate = "Aug"
    ElseIf Month(Int(Now())) = 9 Then
    mdate = "Sep"
    ElseIf Month(Int(Now())) = 10 Then
    mdate = "Oct"
    ElseIf Month(Int(Now())) = 11 Then
    mdate = "Nov"
    ElseIf Month(Int(Now())) = 12 Then
    mdate = "Dec"
End If
ydate = Year(Int(Now()))


LogFileName = "\\n530fs\PTSecurity\" & ydate & "_" & mdate & "_APPROVALS.LOG"
    FileNum = FreeFile ' next file number
    Open LogFileName For Append As #FileNum ' creates the file if it doesn't exist


'*****around here is where I want to put the check and wait?************


    Print #FileNum, LogMessage ' write information at the end of the text file
    Close #FileNum ' close the file
End Sub

I have certain sheets that I want to copy into a workbook I have saved on the C:drive (C:\Book1.xls). I want to do this numerous times so I want to leave Book1.xls as a template for lack of a better word.

I want to know how to code the following:
open book1.xls copy certain worksheets into the book1.xls,
saving book1.xls as another name (based on a variable in the active workbook) to C:\PATS,
closing book1.xls, the original workbook that I copied the sheets from, and how to keep open the new book as well as how to close that too.

thanks in advance

so far i got this:

Dim strNewFolderName As String
Dim rng, rng2 As Range
Dim Msg30, Msg31, style30, title30, response30, response31


Set rng = Sheets("CoDetails").Range("K5")


MyFile2 = rng.Text
    
strNewFolderName = "PATS" 'define folder name


MkDir ("c:\" & strNewFolderName) 'make the directory


With ThisWorkbook
        With .Sheets("CustomSummary")
            .Visible = True
           ' .Unprotect password:= "nipibrmi"
            .Copy
            .Visible = False
        End With
        
        With .Sheets("Finance")
            .Visible = True
            .Copy After:=Sheets(1)
            .Visible = False
        End With
        
        With .Sheets("FinanceSummary")
            .Visible = True
            .Copy After:=Sheets(1)
            .Visible = False
        End With
end with


Application.Workbooks.Open "C:\Book1.xls"


With Sheets("Custom Summary")
        .UsedRange.Copy
        .Select
        .UsedRange.PasteSpecial Paste:=xlValues
         .Visible = True
    End With
    Application.CutCopyMode = False
    
For iWS = 2 To Worksheets.Count 'loop for all sheets after summary
 
    With Sheets(iWS)
        .Select
        .Unprotect
        .UsedRange.Copy
        .UsedRange.PasteSpecial Paste:=xlValues 'cannot do this on ADMIN sheet
        .Protect Password:="nipibrmi"
        .Visible = False
         Application.CutCopyMode = False     'newly added
   End With


Next


ActiveWorkbook.SaveAs filename:="C:\" & strNewFolderName & "\" & MyFile2 'save file

[hr]*[/hr] Auto Merged Post;[dl]*[/dl]The reason why I want to do this is because Book1.xls has a password protected VBA project lock, and I figure if I copy sheets into this workbook as compared to a new one, my code on the worksheets I'm copying over into Book1.xls will be protected and not viewable. If that is not the case, please advise.
Thanks

Re: Locking Vba Project With Code

The code is protected in the main book. The issue is trying to protect the code in the new book.
E.G. VBA Project Protected Workbook 1 contains sheets 1,2,3
Email creates workbook 2 containing only sheet 3 (carrying over worksheet code containing password text spelled out in the code, along with other code to continue the process)

How do I hide the code in workbook 2 to keep the user's from seeing the password?

Re: Locking Vba Project With Code

I unlock the main workbook in order to select certain sheets and copy them into a new workbook that I save and email. This new workbook is protected and needs to have the ability via code to be unprotected. The issue is that a user could view the worksheet code and see my password="blah" statement.
I've seen others attempt to solve this by making a sheet veryhidden and hiding a password on this sheet which is referenced in code. However, a user could just as easily run code which retrieves that cell's value.
I have also found code to copy lines of code from one module to another workbook module, however, if the project isn't locked, the user can still find this code.
Any ideas?
Thanks,

I understand that we can protect the VBA coding through check the "Lock project from viewing in the Tools>VBAProject Properties. However I would like to know if this is possible in code?

I have a mainworkbook for users that has the VBA coding protected (it contains passwords to unlock protected sheets / main workbook). In my program, the users will be entering data and then push a button which calls a macro to email a "skinny down version" of the main book to other users. Problem is, these users that receive the email will be able to get into the VBA code and see what the password is on the sheets. (even if the new workbook/worksheets are password protected)

Is there any way when I save the new book to add this protection to the VBA code?

Thanks in advance

Re: Check If Connected To Network

Thanks Dave, I don't know why I couldn't find that thread in my search!

Quote from Dave Hawley

http://www.ozgrid.com/forum/showthread.php?t=29757 many other examples also. Don't be scared to search

I have created an application for users that requires the user be connected to the network. I wanted to do a check to see if they are connected, and if the user is not connected they would get a message box telling them that they need to be connected to the network, then the workbook would close.

Below is the code I have, but when a user is not connected they do not get my messagebox, instead they get the excel error message "excel run-time error '52': bad file name or number", and the debugger line that gets highlighted is in the function DirExists that checks the length of the directory of the file path: Len(Dir(strpath))

Option Explicit


Function DirExists(strpath As String) As Boolean


    If Len(Dir(strpath)) = 0 Then 'this is where the debugger highlights
        DirExists = False
      Else
        DirExists = True
    End If
End Function


Private Sub Workbook_Open()


    Dim strpath As String
    Dim strfile, strfile2 As String
    
    strpath = "\\n530fs1\PCLFileShares\pcl_reposit\Pricing_Tools\PAT\"
 
    If Not DirExists(strpath) Then
        MsgBox ("           You Don't appear to be connected to the network, this file only works when this connection is available.")
        Exit Sub 
        ActiveWorkbook.Close Savechanges:=False
    End If


end sub

Could anyone please help me figure this out? Thanks in advance[hr]*[/hr] Auto Merged Post;[dl]*[/dl]Anyone out there to help? Thanks