Posts by archleo

Re: Getting Events of Dynamically Added Form Controls

Hi cytop

I'm still unable to solve my issue, I've worked hard, searched a lot, have tried may be 100 code solutions, but it seems that no one works or I'm a real idiot and cannot be able to see the solution. Can you show me a way out and help me? It is highly highly appreciated my friend.

Regards,

Levent

Re: Getting Events of Dynamically Added Form Controls

cytop,

Normally I would read the value of a checkbox and assign a value to a variable like this:

if CheckBox1.Value = True then
    myValue1 = "10"
else
myValue1 = ""
end if


if CheckBox2.Value = True then
myValue2 = "20"
else
myValue2 = ""
end if

I do apologize for my dumass question but I'm not quite understood how can I get this from this situation.

Re: Getting Events of Dynamically Added Form Controls

Quote from cytop;749295

You forgot

Code

Set chkBoxColl = New Collection

Or just declare it ' ... As New...' but people generally don't like that.

cytop you are an angel my friend...
it worked like a charm...
However, I think I'm missing something here, because it only reads the last added control name with the cBox_Click() event. However, I have to be able to read all of them, because I have to assign a public variable to all in order to read the checked/unchecked status of them. How can I manage this?

Hi valuable Members,

I'm dynamically adding (via VBA) a number of CheckBox controls to my UserForm, which reads the number of controls to be added from a variable. I have searched some forums on how to get the values and/or events of these checkboxes and finally found an answer that I have to go thru a collection of events. I have created a class module, and structured my UserForm_Initialize event, however when I run the UF, it fires an error:

Quote

Run-time error '91':

Object variable or With block variable not set

Here are my codes and I appreciate your help. Best regards to you all.
Class Module - clsBoxEvent

Option Explicit


Public WithEvents cBox As MSForms.CheckBox


Private Sub cBox_Click()
    MsgBox cBox.Name
End Sub

UserForm Module

Dim chkBoxEvent As clsBoxEvent
Dim chkBox As MSForms.CheckBox
Dim chkBoxColl As Collection


Private Sub UserForm_Initialize()
    Dim nchk As Integer
    nchk = Worksheets("Sayfa1").Range("A1").Value
    For i = 1 To nchk
        Set chkBox = Me.Controls.Add("Forms.CheckBox.1", "CheckBox" & i)
        With chkBox
            .Left = 126
            .Height = 16
            .Top = 6 + ((i - 1) * 16)
            '.Caption = pckName(i)
        End With
        Set chkBoxEvent = New clsBoxEvent
        Set chkBoxEvent.cBox = Me.Controls(chkBox.Name)
        chkBoxColl.Add chkBoxEvent
    Next i
End Sub

Re: Looking for a VBA code to protect deletion of rows

It is a 3 simple step where you do not need a macro:

1.) Select your range of cells you wish to allow to be changed and choose FORMAT CELLS from the context menu, click the PROTECT tab. Uncheck the "locked" box. and click OK.

2.) Go to Tools > Protect > Protect Sheet

3.) Check everything you want to allow... uncheck things you wish not to allow

Do not forget to enter a memorable password (2 times...)

Voila...

Re: Code to auto filter data base on a list of file and generate different reports

Hi David,

Regarding your question; simplest thing to do would be to append each filtering criteria to a dynamic variable and then according to your selection of Country and Business type, apply the filtering according to that criteria. I've understood (hopefully) your problem however it is not so possible to design or re-structure a code without seeing your macro. Please do find below a code snippet that I currently use on one of my files:

Sub RFI_SWS() 
      '********************************************
      'RFI LOG - SW BLOCKS
      '********************************************
    Application.ScreenUpdating = False 
     Dim wbRFI As Workbook 
     Set wbRFI = Workbooks.Open(fileRFI) 
     Dim lRow As Long 
    Sheets("RFI_LOG").Select 
    Sheets("RFI_LOG").Activate 
    Sheets("RFI_LOG").Range("AZ1").Value = "REPORT" 
    lRow = Cells(Cells.Rows.Count, "M").End(xlUp).Row 
    lRow = lRow - 16 
     
    ActiveSheet.Range("$A$1:$M$" & lRow).AutoFilter Field:=13, Criteria1:=IsRFIClosed 
    Calculate 
    ActiveSheet.Range("$A$1:$M$" & lRow).AutoFilter Field:=4, Criteria1:=Discipline 
    Calculate 
    ActiveSheet.Range("$A$1:$M$" & lRow).AutoFilter Field:=5, Criteria1:=Array("SW1", "SW2", "SW3", "SEND", "SEND-S1", "SEND-S2"), Operator:=xlFilterValues 
    Calculate 
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, filename:="L:\REPORTS\RUNTIME\" & selectedPckID & "_RFI2.pdf", _ 
    Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False 
     
    ActiveSheet.Range("$A$1:$M$" & lRow).AutoFilter Field:=13 
    ActiveSheet.Range("$A$1:$M$" & lRow).AutoFilter Field:=4 
    ActiveSheet.Range("$A$1:$M$" & lRow).AutoFilter Field:=5 
    Calculate 
     
    wbRFI.Close False 
     Set wbRFI = ]Nothing 
    Application.ScreenUpdating = True 
End Sub

Re: Code to send emails to a list of recipients (both to and cc) from excel

Hi David

Please download the workbook from below link for your question. Hope that it helps.
https://www.dropbox.com/s/v12naqka5e2atyf/MailingSampleWB.xlsm?dl=0

For others to see the solution:
Workbook contains a Module and a UserForm

Module Level Coding:

Option Explicit
Public cSplitted As Variant
Public OutApp As Object
Public OutMail As Object
Public sh As Worksheet
Public cell As Range
Public FileCell As Range
Public Rng As Range
Public ReportDate As Date
Public NextReportDate As Date
Public ReportingCountry As String
Public Business As String
Public sendMail As Integer
Public i As Long
Public mTo As Range
Public mCc As Range




Public Function GetFileName(cValue As Variant)
    Dim splitList As Variant
    On Error Resume Next
    splitList = VBA.Split(cValue, "\")
    cSplitted = splitList(UBound(splitList, 1))
End Function




Sub SendReports()
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With
    
    '// Format the date as per your needs, just change this line to,
    '// i.e.: Report Date = Format(CDate(Range("H1").Value), "dd-mm-yyyy"
    ReportDate = CDate(Range("B2").Value)
    NextReportDate = CDate(Range("B3").Value) '//Same apply here
    
    Set sh = Sheets("MAILING") '//You can change this Worksheet Name
    Set OutApp = CreateObject("Outlook.Application")
    '// Enter the path/file names in the E:F range in each Country's row. If you will send more than 2 reports for a country,
    '// than extend this range accordingly i.e. E to Z etc.
    Set Rng = Range("E" & mTo.Row & ":F" & mTo.Row)




    If mTo.Value Like "?*@?*.?*" And Application.WorksheetFunction.CountA(Rng) > 0 Then
        Set OutMail = OutApp.CreateItem(0)
        GetFileName (mTo.Offset(0, 2).Value)
        With OutMail
            .to = mTo.Value
            .cc = mCc.Value
            .Subject = Business & " " & ReportingCountry & " Report - " & ReportDate
            '// Body message is according to your example. You can change this as per your needs and wording
            .Body = "Dear All," & vbCrLf & vbCrLf & "Attach here is the report for " & Business & " " & ReportingCountry & ". The next report date will be " _
                    & NextReportDate & ". Please kindly have a look and comment." & vbCrLf & vbCrLf & "Thanks"
                
            For Each FileCell In Rng.SpecialCells(xlCellTypeConstants)
                If Trim(FileCell) <> "" Then
                    If Dir(FileCell.Value) <> "" Then
                        .Attachments.Add FileCell.Value
                    End If
                End If
            Next FileCell
            If sendMail = 0 Then
                .Display
            ElseIf sendMail = 1 Then
                .Send
            End If
        End With
        Set OutMail = Nothing
    End If
        
    Set OutApp = Nothing
    
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub

UserForm Level Coding:

Private Sub cmbCountry_Change()
    i = cmbCountry.ListIndex + 6
End Sub


Private Sub cmdDisplay_Click()
    ufMailing.Hide
    Unload Me
    ReportingCountry = cmbCountry.Value
    Business = Range("B" & i).Value
    sendMail = 0
    Set mTo = Range("C" & i)
    Set mCc = Range("D" & i)
    Module1.SendReports
End Sub


Private Sub cmdSend_Click()
    ufMailing.Hide
    Unload Me
    ReportingCountry = cmbCountry.Value
    Business = Range("B" & i).Value
    sendMail = 1
    Set mTo = Range("C" & i)
    Set mCc = Range("D" & i)
    Module1.SendReports
    MsgBox "Your Management Report(s) has been sent to:" & vbCrLf & vbCrLf & OutMail.to & "; " & OutMail.cc, vbInformation, "MAILING REPORT..."
End Sub


Private Sub cmdCancel_Click()
    sendMail = 2
    ufMailing.Hide
    Unload Me
End Sub


Private Sub UserForm_Initialize()
    Dim lastRow As Long
    lastRow = Worksheets("MAILING").Range("A" & Rows.Count).End(xlUp).Row
    cmbCountry.RowSource = "'MAILING'!A6:A" & lastRow
End Sub

Regards,

Levent

OPs: Sorry for providing a dropbox link, however I couldn't manage to attach the file here.

Re: Code to send emails to a list of recipients (both to and cc) from excel

Quote from ducdohoang;747766

Hi archleo,

Thank you very much for your kind support. I am highly appreciated it.

Best Regards

David

Display More

Good morning David,

Sorry for replying you late, but I've had a problematic net connection thru my ISP yesterday night.
I have some questions regarding your solution:
1.) Is your business type fixed with respect to countries? I mean i.e. is F&B only for UK and Trading only for US? Or does every country own every business type?
2.) Are there only one email address in TO and CC? Will there be more people (esp. in CC)?

Best regards,

Levent

Re: Code to send emails to a list of recipients (both to and cc) from excel

Quote from ducdohoang;747761

Hi Archleo,

Thank you for your kind help. For the code you provided, what is the range E5:Z5 for? Assuming the report date and next report date are fixed among all emails (I will only change in the next month when I generate report, and I want to attach 2 files as sample Excel I attached here, then how should I modify the code to make it work?

Thank you very much and I am highly appreciate your help

Best Regards

David

forum.ozgrid.com/index.php?attachment/65497/

Display More

Hi ducdohoang,

I'm on the way to home and I will respond to your thread in a couple of hours. FYI, E1:Z1 Range is reserved for attachments as I don't have any idea how many reports you want to send regarding each 'Business'. I'll try to modify the code as per your needs tonight and send it.

Best regards,

Hi valuable forum members,

Firstly I want to explain the situation (with simple and short wordings hopefully :smile: )

1. I've prepared a Document Management Log in Excel with full of macros, procedures etc. (the problem that you've solved was a part of that system by the way)
2. All the files of that system is partly and sometimes fully linked together.
3. All the system files lies in a network drive (L:\)
4. All the system files lies in their respective folders (i.e. MP02, MP03 etc.)
5. As I don't want any user copy or move any system file outside their drive & folder, I've constructed a simple code under Workbook_Open() Event, so that it cannot be operated, like below:

Private Sub Workbook_Open()      If InStr(LCase(ThisWorkbook.FullName), "l:\esso") = 0 Then        MsgBox "ATTENTION!! THE FILE YOU WANTED TO OPEN IS PART OF A PROJECT AND CANNOT BE EXECUTED OUTSIDE ITS WORKING ENVIRONMENT. THIS FILE WILL BE CLOSED NOW...", vbExclamation, "UNAUTHORIZED USE DETECTED..."         ThisWorkbook.Close False     Else. . .      End IfEnd Sub

Re: Code to send emails to a list of recipients (both to and cc) from excel

You can try this:
This code also attaches the Excel report (or any other file you've specified) to your mail
Assuming that you're using outlook and full path+file name of the report lies in Range("E5:Z5")
Assuming that you're sending one (or more than one) report at the same e-mail
Assuming that WorkSheet name is "MAILING" (you can change this according to your needs)

I've little bit changed your table, but you can edit the table and code accordingly as per your needs

[TABLE="class: grid, width: 1000, align: left"]

A

B

C

D

E

.

.

AA

AB

1

UK

F&B

[email protected]

[email protected]

C:\Downloads\UK_Report.pdf

Report Date

05-05-2015

2

US

Trading

[email protected]

[email protected]

C:\Downloads\US_Report.pdf

Next Report Date

08-08-2015

[/TABLE]

Public cSplitted As Variant
Public OutApp As Object
Public OutMail As Object
Public sh As Worksheet
Public cell As Range
Public FileCell As Range
Public Rng As Range


Public Function GetFileName(cValue As Variant)
    Dim splitList As Variant
    On Error Resume Next
    splitList = VBA.Split(cValue, "\")
    cSplitted = splitList(UBound(splitList, 1))
End Function


Sub SendReports()
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With


    Set sh = Sheets("MAILING") '//You can change that Worksheet Name
    Set OutApp = CreateObject("Outlook.Application")


    For Each cell In sh.Columns("C").Cells.SpecialCells(xlCellTypeConstants)
        
        Set Rng = sh.Cells(cell.Row, 1).Range("E1:Z1") '// Enter the path/file names in the E:Z column in each row


        If cell.Value Like "?*@?*.?*" And _
           Application.WorksheetFunction.CountA(Rng) > 0 Then
            Set OutMail = OutApp.CreateItem(0)
            GetFileName (cell.Offset(0, 2).Value)
            With OutMail
                .to = cell.Value
                .cc = cell.Offset(0, 1).Value
                .Subject = cell.Offset(0, -1).Value & " " & cell.Offset(0, -2).Value & " Report - " & cell.Offset(0, 25).Value
                .Body = "Dear All," & vbCrLf & vbCrLf & "Attach here is the report for " & cell.Offset(0, -1).Value & " " & cell.Offset(0, -2).Value & ". The next report date will be " _
                            & cell.Offset(1, 25).Value & ". Please kindly have a look and comment." & vbCrLf & vbCrLf & "Thanks"
                
                For Each FileCell In Rng.SpecialCells(xlCellTypeConstants)
                    If Trim(FileCell) <> "" Then
                        If Dir(FileCell.Value) <> "" Then
                            .Attachments.Add FileCell.Value
                        End If
                    End If
                Next FileCell
                .Display
            End With
            Set OutMail = Nothing
        End If
        
    Next cell
    
    Set OutApp = Nothing
    
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub

Re: How To Refresh UserForm ListBox

Hi cytop,

I don't know how to thank you my friend. Everything is just like I wanted know the code works flawlessly...
Thank you so much for your help and efforts...
Problem solved, case closed...

Re: How To Refresh UserForm ListBox

Quote from cytop;747162

OK - have nothing to do this afternoon. I'll edit your userform and post back later...

God bless you cytop...Thank you so much for your help
And provided one day you think to take a trip or vacation to Istanbul, Turkey, I'll be honoured to guest you.
Regards,

Re: How To Refresh UserForm ListBox

Quote from cytop;747149

Unfortunately, I think language barriers are a little high here - and English is my second language too

Hi cytop,

It is very well understood now that both your English and understanding are better than me pal

What I want is exactly what you have written in 3 simple lines Shame on me that I just keep telling them with 3 full+full paragraphs :duh:

1.) The files are named like 150526_MP02_Submittal_Log.xlsm. ListBox.Column1 shall be filled with the date as specified in the filename

2.) ListBox.Column2 will contain the remainder of the file name with _'s replaced by spaces.

3.) The user then double clicks an item, the full filename is build up and .......

I also attach my files latest update FYI...forum.ozgrid.com/index.php?attachment/65389/

You are a great guy and I appreciate your efforts. Thank you so much.

Re: How To Refresh UserForm ListBox

Quote from cytop;747086

I'm sorry, maybe I'm having a bad day but I don;t understand what you mean by "...sort the listbox in a way that date matches the FName"

I'm also sorry provided I couldn't express my issue well as for a couple of hours I see everything like sub, private sub, dim, private declare etc.
What I've try to meant was: (please do apologize my dumb ass explaining style)
1. My filename format in relevant folders are: yymmdd_PackageNr_Submittal_Log.xlsm (i.e. 150527_MP02_Submittal_Log.xlsm)
2. File filename is read, put it in a listbox (lbFileList) row and the name is divided into 2 columns: Date & Filename (I have little bit changed your code like below)

While fName <> ""
        If InStr(fName, logType) > 0 Then
            k = k + 1
            ReDim Preserve fileList(1 To k)
            fileList(k) = fName
            With ufBackupList.lbFileList
                .AddItem fileList(k)
                 '// Formatted the date as needed
                .List(.ListCount - 1, 0) = Format(FileDateTime(fPath & fName), "dd-mm-yy")
                .List(.ListCount - 1, 1) = Replace(Mid(fName, 8, 18), "_", " ")
            End With
        End If
        'get next filename
        fName = Dir()
    Wend

3. When the user chooses a backup file and double click, filename can be read appropriately

MsgBox fileList(lbFileList.ListIndex + 2)

No problem till here...
But I want lbFileList listbox to be sorted in descending order (both columns), but "...sort the listbox in a way that date matches the FName" meaning:
(selected item; theoretically) listbox column0 value ("27-05-15") + listbox column1 value ("MP02 Submittal Log") should point out "150527_MP02_Submittal_Log.xlsm"
What the problem might be here is; there are some files where (manually given during saveas) "yymmdd" part of the filename might not match with the FileDateTime function, because there we read the actual saved date&time of the file. I mean; today (27/05/2015) I save the file but the log belongs to yesterday's data, so I saveas the file 150526_MP02_Submittal_Log.xlsm.

To overcome this problem, I had tried to get the "date" values with below coding:

Format(CDate(Mid(fName, 5, 2) & "/" & Mid(fName, 3, 2) & "/" & Mid(fName, 1, 2)), "dd-mm-yy")

Sorry for too long explanation for a simple question, but I just wanted to reflect my idea very clearly.

Thnx for your efforts pal...

Re: How To Refresh UserForm ListBox

Quote from cytop;747071

You could try this: http://www.ozgrid.com/forum/showthread.php?t=71509

Hi cytop,

In fact this was the thread influenced me for sorting the listbox items (see my code above).
My backup files are named with a format like "yymmdd_PackageNr_Submittal_Log.xlsm". As I didn't know how to stripe the file date (thnx to show me that on your code with FileDateTime(fPath & fName) I have tried to do that with CDate function by slicing the fName with Mid function putting the value to the first column of the Listbox. After that I've striped the year part from the fName and put the value to the second column with replacing "underscore" char's with spaces for a better look&feel. I was trying to do this splitting under the SortListBox procedure. That's what I have done bur couldn't managed so far

Simply, I want to get the file list from the relevant folder (that's done), put them on a listbox with Date & FName columns (that's done too), sort the listbox in a way that date matches the FName (that's missing) and let the user open the backup log with double click the filename (that's easy if I can properly read the fPath and fName)

Re: How To Refresh UserForm ListBox

Thank you very much cytop...Now it works just like I wanted.
Could you please also check the procedure SortListBox where I've tried to sort the items in lbFileList listbox?

Sub SortListBox(oLb As MSForms.ListBox)
    Dim i As Long, j As Long
    Dim vTemp As Variant
    i = 0
    'Put the items in a variant array
    'ReDim vItems(i)
    vItems = oLb.List
    
    ' Sort
    For i = 0 To UBound(vItems, 1) - 1
        For j = i + 1 To UBound(vItems, 1)
            If vItems(i, 0) < vItems(j, 0) Then
                vTemp = vItems(i, 0)
                vItems(i, 0) = vItems(j, 0)
                vItems(j, 0) = vTemp
            End If
        Next
    Next
    
    'Clear the listbox
    oLb.Clear
    
    'Add the sorted array back to the listbox
    For i = 0 To UBound(vItems)
        oLb.AddItem 'vItems(i, 0)
        oLb.List(i, 0) = CDate(Mid(vItems(i, 0), 5, 2) & "/" & Mid(vItems(i, 0), 3, 2) & "/" & Mid(vItems(i, 0), 1, 2))
        oLb.List(i, 1) = Mid(vItems(i, 0), 8)
    End With
End Sub

when I ran this code, I'm getting "Subscript Out of Range" error and the debugger points out this line:

oLb.List(i, 0) = CDate(Mid(vItems(i, 0), 5, 2) & "/" & Mid(vItems(i, 0), 3, 2) & "/" & Mid(vItems(i, 0), 1, 2))

Re: How To Refresh UserForm ListBox

Quote from cytop;747055

ReDimming an array is nothing to do with a Listbox not clearing. From what you've posted, you've tried the Clear method and it didn't work.

Post a sample copy (<~100kb) of your workbook that displays the issue.

Hi cytop,

Please do find attached my workbook. I appreciate your help.

forum.ozgrid.com/index.php?attachment/65369/

Re: How To Refresh UserForm ListBox

Quote from cytop;747048

I don't understand

There is no line in your code to clear the listbox... so everything just gets added in again. Look at DisplayFoldersInListBox, you'll see a Listbox.CLear statement, for example.

Hi cytop,

ListBox.clear statement at DisplayFoldersInListBox procedure only clears the lbFolderList listbox. As I have tried to explain above, I want lbFileList listbox to be cleared when user clicks/double clicks a "foldername" item in lbFolderList listbox. But though I have tried to put a statement like:

ufBackupList.lbFileList.Clear

in every possible place in the code, lbFileList is not cleared and filenames of selected folder always added to the end of the previous list.
I have thought that the problem is within the dynamic array where I collect the filenames. From the code below:

While fName <> "" 
         'add fName to the list
        If InStr(fName, "Submittal") > 0 Then 
            k = k + 1 
            Redim Preserve fileList(1 To k) 
            fileList(k) = fName 
        End If 
         'get next filename
        fName = Dir() 
    Wend

I've understood that re-dimesioning an array with the "preserve" option, means to enlarge the array, preserving the data it previously have. I've tried to reset the array or empty the array in the very beginning of the procedure, but I couldn't manage it. Erasing the array, when the procedure called upon user click/double click a foldername item, results in empty list of items first followed by the new list of the foldername choosen.

Re: How To Refresh UserForm ListBox

Quote from cytop;747042

You don't actually Clear the Listbox first...

So sorry for the missing code...Here it is, but it does not clear the listbox...I've tried the piece of clearing line every possible place in my code

Sub constructFileList()
    'define the directory to be searched for files
    fPath = "L:\ESSO\08. BACKUPS\MP02\" & backupFN & "\"
    'build a list of the files
    fName = Dir(fPath & "*.xlsm")
    While fName <> ""
            'add fName to the list
        If InStr(fName, "Submittal") > 0 Then
            k = k + 1
            ReDim Preserve fileList(1 To k)
            fileList(k) = fName
        End If
        'get next filename
        fName = Dir()
    Wend
        'see if any files were found
    If k = 0 Then
        MsgBox "No files found"
        Exit Sub
    End If
    ufBackupList.lbFileList.Clear
    'cycle through the list and add to listbox
    For k = 1 To UBound(fileList)
        ufBackupList.lbFileList.AddItem fileList(k)
    Next
End Sub