MsgBox to Show what files are being created?

Guanjin Peter

Active Member
Joined
May 21, 2008
Messages
429
With the given output from db, it'll generate 3 files:
papa 11_Jun_2008.xls
mama 11_Jun_2008.xls
son 11_Jun_2008.xls

I was thinking is it possible to modify the msgBox below to show that the above files are created? I can't really put papa, mama, son all the time as the names may change anytime.

Code:
newDate = Format$(ThisWorkbook.Sheets("template").Range("b3").Value, "dd_mmm_yyyy")
Dim box1 As Integer
    box1 = MsgBox("Create Driver Files dated " & newDate & " ?", 1 + vbExclamation, newDate & ": Export Files? ")
    If box1 = 1 Then

Code:
Private Sub CommandButton1_Click()
 If IsDate(Range("B3")) = flase Then 'simple msg box to check if date,cell(b1) is empty
    MsgBox "Invalid Date!", vbExclamation, "No Date" 'no update until date,cell(b1) is filled
Else
    
    newDate = Format$(ThisWorkbook.Sheets("template").Range("b3").Value, "dd_mmm_yyyy")
    Dim box1 As Integer
    box1 = MsgBox("Create Driver Files dated " & newDate & " ?", 1 + vbExclamation, newDate & ": Export Files? ")
    If box1 = 1 Then
    
    Dim Rng As Range
    Dim c As Range
    Dim List As New Collection
    Dim name As Variant
    Dim WbkNew As Workbook
    Dim wbkName As String
    Dim shName As String
    
Dim Sh As Worksheet
Set Sh = Worksheets("db")
    Application.ScreenUpdating = False
   
Dim template As Worksheet
Set template = ActiveWorkbook.Sheets("template")
     
Dim ShProd As Worksheet
Set ShProd = ActiveWorkbook.Sheets("products")
Application.ScreenUpdating = False
'----------------------create driver worksheet in protoV3.xls---------------
With Sh
       
 'add individual driver's name to list(store)
        Set Rng = .Range("J2:J" & .Range("J" & .Rows.count).End(xlUp).Row)
        On Error Resume Next
        For Each c In Rng
            List.Add c.Value, CStr(c.Value)
        Next c
        On Error GoTo 0
   'range to be copied to individual driver's worksheet
        Set Rng = .Range("A1:J" & .Range("A" & .Rows.count).End(xlUp).Row)
      
  For Each name In List 'for each driver
           Set ShNew = Workbooks.Add
        
template.Range("A1").Copy
    
      With ShNew
               wbkName = name 'item=driver's name
                                
  'Dim LColAMaster As String
                
 template.Cells.Copy Destination:=ShNew.Sheets("Sheet1").Range("A1")
Worksheets("Sheet1").Cells(3, 11).Value = wbkName
Dim intRow As Integer
Dim rProd As Range, rCust As Range
intRow = 2
Do While Sh.Cells(intRow, 5).Value<> ""
If CStr(Sh.Cells(intRow, 10).Value) = Worksheets("Sheet1").Cells(3, 11).Value Then
Worksheets("Sheet1").Range("a3") = "Date"
Worksheets("Sheet1").Range("a4") = "Area"
Worksheets("Sheet1").Range("j3") = "Driver"
Worksheets("Sheet1").Range("j4") = "Vehicle"
Worksheets("Sheet1").Range("a5") = " "
Worksheets("Sheet1").Range("a6") = "S/NO"
Worksheets("Sheet1").Range("b5") = " "
Worksheets("Sheet1").Range("b6") = "CustID"
Worksheets("Sheet1").Range("c5") = " "
Worksheets("Sheet1").Range("c6") = "Customer"
Worksheets("Sheet1").Range("d5") = " "
Worksheets("Sheet1").Range("d6") = "Invoice"
Worksheets("Sheet1").Range("e5") = " "
Worksheets("Sheet1").Range("e6") = "Remarks"
    proid = Sh.Cells(intRow, 6).Value
    pro = Sh.Cells(intRow, 7).Value
    Set rProd = Worksheets("Sheet1").Cells(5, Columns.count).End(xlToLeft)
    rProd.Offset(0, 1).Value = proid
    rProd.Offset(1, 1).Value = pro
    custID = Sh.Cells(intRow, 4).Value
    cust = Sh.Cells(intRow, 5).Value
    Set rCust = Worksheets("Sheet1").Range("b" & Columns.count).End(xlUp)
    rCust.Offset(1, 0).Resize(, 2) = Array(cust, custID)
    qty = Sh.Cells(intRow, 8).Value
    Worksheets("Sheet1").Cells(rCust.Row + 1, rProd.Column + 1).Value = qty 'Cells(,start at which column?)
       
           End If
            
            intRow = intRow + 1
        Loop
        
        
    ShNew.SaveAs ThisWorkbook.Path & "\" & wbkName & " " & newDate
    
           Dim a, b(), i As Long, ii As Integer, n As Long, z As String
        With ShNew.Sheets("Sheet1")
            With Intersect(.Rows("5:" & Rows.count), .UsedRange)
            a = .Value
            ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2))
                For i = 1 To UBound(a, 2)
                    b(1, i) = a(1, i): b(2, i) = a(2, i)
                Next
                n = 2
                With CreateObject("Scripting.Dictionary")
                .CompareMode = vbTextCompare
                    For i = 3 To UBound(a, 1)
                    z = a(i, 2) & ";" & a(i, 3)
                        If Not .exists(z) Then
                            n = n + 1: b(n, 2) = a(i, 2): b(n, 3) = a(i, 3): .Add z, n
                        End If
                        For ii = 6 To UBound(a, 2)
                            b(.Item(z), ii) = b(.Item(z), ii) + a(i, ii)
                        Next
                    Next
                End With
                .Value = b
            End With
        End With
        
    'ShNew.Sheets("Sheet1").Columns("a:z").EntireColumn.AutoFit
    ShNew.Close True
            End With
        Next name
   
    
    End With
    count_down_timer
    Else
    End If
End If
End Sub
protoV5.xls
ABCDEFGHIJ
1Date(dd/mm/yy)MonthsCustomerOutletCustomerIDProductIDProductQtyUomDriver
211-06-2008June7Shop7Shop064-03*BALRDC****-064RFG-**508CaliforniaTuna2PKTFather
311-06-2008June7Shop7Shop064-03*BALRDC****-064RFG-**508CaliforniaTuna2PKTMama
411-06-2008June7Shop7Shop064-03*BALRDC****-064RFG-**508CaliforniaTuna2PCSSon
511-06-2008June7Shop7Shop064-03*BALRDC****-064RFG-**508CaliforniaTuna2PKTFather
611-06-2008June7Shop7Shop064-03*BALRDC****-064RFG-**501RoastMexicanChicken2PKTMama
711-06-2008June7Shop7Shop064-03*BALRDC****-064RFG-**501RoastMexicanChicken2KGSon
811-06-2008June7Shop7Shop064-03*BALRDC****-064RFG-**511ChickenBolognaise2KGFather
911-06-2008June7Shop7Shop064-03*BALRDC****-064RFG-**511ChickenBolognaise5KGMama
1011-06-2008June7Shop7Shop064-03*BALRDC****-064TDG-**002TunaCheesePizzaBar15KGSon
1111-06-2008June7Shop7Shop064-03*BALRDC****-064RFG-**588ThaiChickenFriedRice15KGFather
1211-06-2008June7Shop7Shop217-00*THOMSONRDC****-217RFG-**502ClubSandwich3PKTMama
1311-06-2008June7Shop7Shop217-00*THOMSONRDC****-217RFG-**501RoastMexicanChicken15PKTSon
1411-06-2008June7Shop7Shop217-00*THOMSONRDC****-217RFG-**501RoastMexicanChicken12pcsFather
1511-06-2008June7Shop7Shop217-00*THOMSONRDC****-217TDG-**002TunaCheesePizzaBar15pcsMama
1611-06-2008June7Shop7Shop373WHAMPODRIVEC****-373RFG-**501RoastMexicanChicken10KGSon
db
 

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.

Watch MrExcel Video

Forum statistics

Threads
1,130,045
Messages
5,639,751
Members
417,108
Latest member
Thein Than

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top