How/Where to insert Userforms in Macro Code

[LeanneBG]

Hi All! Anyone here knows how and where should i insert a code so i can add the userform i created? I wanted to include this in the code so that i'm aware of the progress of the macro. For background: the macro is creating new workbooks (or splitting the files perse) depending on the data i have. Thus, i want to include this userform so i will be aware of the progress/status. Below is my code for the splitting part. I have 2 userforms, UserForm1 is for the progress, the other one (Userform2) is for when the macro is done running. ANy help is appreciated. Thanks! Here's the link for the userforms image:

https://www.dropbox.com/s/r8w925655bp3294/userform1.PNG?dl=0 - Userform1
https://www.dropbox.com/s/1tq5nwzrhgrn0yx/userform2.PNG?dl=0 - Userform2

Sub ParseGroups()
'JBeaucaire (11/11/2009)
'Based on column A, data is filtered to individual workbooks
Dim LR As Long, i As Long, MyCount As Long, MyArr
Dim ws As Worksheet, wsNew As Worksheet
Dim Path As String
Application.ScreenUpdating = True
Application.DisplayAlerts = False
Path = Worksheets("Menu").Range("A10")
If Dir(Path & "/Reports", vbDirectory) = "" Then
MkDir Path & "/Reports"
Path2 = Path & "/Reports/"
End If
Set ws = Sheets("Raw") 'edit to your data sheet name
ws.Activate 'insure data sheet is active
'Store the bottom row of data as a variable
LR = Range("A" & Rows.Count).End(xlUp).Row
'Create a unique list of values from column A
Columns("A:A").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("BB1"), Unique:=True
'Sort the list alphabetically
Columns("BB:BB").Sort Key1:=Range("BB2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
'Put the list into an array in memory
MyArr = Application.WorksheetFunction.Transpose(Range("BB2:BB" & Rows.Count).SpecialCells(xlCellTypeConstants))
Range("BB:BB").Clear 'clear the column of values created so sheet is pristine
Range("A:A").AutoFilter 'Turn on the autofilter
For i = 1 To UBound(MyArr) 'loop through array values one at a time
'Filter column A by the current value
Range("A:A").AutoFilter Field:=1, Criteria1:=MyArr(i)
'Create a new blank sheet named for the current array value
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = MyArr(i)
ws.Activate
'Copy current filtered rows to new sheet, values only and formatting preserved
Range("B1:W" & LR).EntireColumn.Copy
Sheets(MyArr(i)).Range("A1").PasteSpecial xlPasteValues
Sheets(MyArr(i)).Range("A1").PasteSpecial xlPasteFormats
'Count how many rows were moved for message later
MyCount = MyCount + Sheets(MyArr(i)).Range("A" & Rows.Count).End(xlUp).Row - 1
'Tighten up appearance
Sheets(MyArr(i)).Columns.AutoFit
'Move new sheet to workbook of its own
Sheets(MyArr(i)).Move
Call CreatePivots
'Save new workbook with array value as name, then close
ActiveWorkbook.SaveAs Path2 & MyArr(i) & ".xlsx"
ActiveWorkbook.Close False
'reset the autofilter
Range("A:A").AutoFilter Field:=1
'End If
Next i 'Loop to next array value
'Turn off autofilter
ActiveSheet.AutoFilterMode = False
'Compare count of rows copied to rows in database, report the results
LR = LR - 1
MsgBox "Rows with data: " & LR & vbLf & "Rows copied to other sheets: " & MyCount & vbLf & "Hope they match!!"
Application.ScreenUpdating = True
Sheets("Raw").Select
Sheets("Raw").Cells.ClearContents
Sheets("Raw").Cells.ClearFormats
Sheets("Menu").Select
End Sub

 

[ExcelSpeedster]

I found this Microsoft guide that does what you need.

Let me know if you succeed with implementation so that we can assist.

 

[LeanneBG]

I found this Microsoft guide that does what you need.

Let me know if you succeed with implementation so that we can assist.

Thanks ExcelSpeedster! However, Im not sure Where exactly to insert the code in my above code? Can you help me guide please? I want the userform to show once the macro starts splitting the files. Can you guide me please? Thank you so much!

 

[ExcelSpeedster]

First, declare the PctDone variable at the top of the ParseGroups sub:

Dim PctDone As Single

Then just above your

Next i

statement, calculate the percentage complete as follows:

PctDone = i / UBound(MyArr)

Lastly, call a new Sub (you must create it) called UpdateProgressBar that updates the progress bar on the userform (similar to the example I sent). Pass the PctDone variable into that Sub:

UpdateProgressBar PctDone

Does that work?

 

[LeanneBG]

Hi ExcelSpeedster! I tried, it wont work L it’s showing attached error. Here’s the updated macro code based on what you said, did I do anything wrong? Im attaching also below the workbook with macro (2nd link). The 3rd link is the file that should be pulled by the macro workbook.

1) https://www.dropbox.com/s/jd2drjsjxim0tck/debug1.PNG?dl=0 - debug image
2) https://www.dropbox.com/s/fu36o9p450mc3bw/WD5 Actuals Line Item_V2.3.xlsm?dl=0 -Macro Workbook
3) https://www.dropbox.com/s/wkm9hp94fp9zdk8/export.XLSX?dl=0 - File to get

Sub ParseGroups()
'JBeaucaire  (11/11/2009)
'Based on column A, data is filtered to individual workbooks
Dim PctDone As Single
Dim LR As Long, i As Long, MyCount As Long, MyArr
Dim ws As Worksheet, wsNew As Worksheet
Dim Path As String
 
Application.ScreenUpdating = True
Application.DisplayAlerts = False
 
Path = Worksheets("Menu").Range("A10")
 
If Dir(Path & "/Reports", vbDirectory) = "" Then
 
    MkDir Path & "/Reports"
    Path2 = Path & "/Reports/"
    End If
   
Set ws = Sheets("Raw")     'edit to your data sheet name
ws.Activate                     'insure data sheet is active
 
'Store the bottom row of data as a variable
    LR = Range("A" & Rows.Count).End(xlUp).Row
 
'Create a unique list of values from column A
    Columns("A:A").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("BB1"), Unique:=True
 
'Sort the list alphabetically
    Columns("BB:BB").Sort Key1:=Range("BB2"), Order1:=xlAscending, Header:=xlYes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
'Put the list into an array in memory
    MyArr = Application.WorksheetFunction.Transpose(Range("BB2:BB" & Rows.Count).SpecialCells(xlCellTypeConstants))
 
Range("BB:BB").Clear        'clear the column of values created so sheet is pristine
Range("A:A").AutoFilter     'Turn on the autofilter
 
 
 
 
For i = 1 To UBound(MyArr)  'loop through array values one at a time
    'Filter column A by the current value
        Range("A:A").AutoFilter Field:=1, Criteria1:=MyArr(i)
       
    'Create a new blank sheet named for the current array value
        Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = MyArr(i)
        ws.Activate
    'Copy current filtered rows to new sheet, values only and formatting preserved
        Range("B1:W" & LR).EntireColumn.Copy
        Sheets(MyArr(i)).Range("A1").PasteSpecial xlPasteValues
        Sheets(MyArr(i)).Range("A1").PasteSpecial xlPasteFormats
    'Count how many rows were moved for message later
        MyCount = MyCount + Sheets(MyArr(i)).Range("A" & Rows.Count).End(xlUp).Row - 1
    'Tighten up appearance
        Sheets(MyArr(i)).Columns.AutoFit
    'Move new sheet to workbook of its own
        Sheets(MyArr(i)).Move
       
        Call CreatePivots
       
    'Save new workbook with array value as name, then close
        ActiveWorkbook.SaveAs Path2 & MyArr(i) & ".xlsx"
        ActiveWorkbook.Close False
    'reset the autofilter
        Range("A:A").AutoFilter Field:=1
    'End If
   
PctDone = i / UBound(MyArr)
 
Call UpdateProgressBar
 
Next i      'Loop to next array value
 
'Turn off autofilter
    ActiveSheet.AutoFilterMode = False
'Compare count of rows copied to rows in database, report the results
    LR = LR - 1
    MsgBox "Rows with data: " & LR & vbLf & "Rows copied to other sheets: " & MyCount & vbLf & "Hope they match!!"
    Application.ScreenUpdating = True
    Sheets("Raw").Select
    Sheets("Raw").Cells.ClearContents
    Sheets("Raw").Cells.ClearFormats
    Sheets("Menu").Select
   
End Sub
 
Sub UpdateProgressBar()
 
UpdateProgressBar PctDone
 
End Sub

 

[ExcelSpeedster]

On the line above "Next i", replace "Call UpdateProgressBar" with "Call UpdateProgressBar PctDone".

Replace your Sub UpdateProgressBar() with this:

Sub UpdateProgressBar(PctDone As Single)
    With UserForm1


        ' Update the Caption property of the Frame control.
        .FrameProgress.Caption = Format(PctDone, "0%")


        ' Widen the Label control.
        .LabelProgress.Width = PctDone * _
            (.FrameProgress.Width - 10)
    End With


    ' The DoEvents allows the UserForm to update.
    DoEvents
End Sub

Have you created a UserForm1 with a frame called FrameProgress and a label called LabelProgress? If not, you need to follow steps 3-9 of the example I sent.

 

[LeanneBG]

Yes i've done the FrameProgess and LabelProgress. Just to clarify, labelprogress is the caption, right?

I've tried to this one: "Call UpdateProgressBar PctDone" without the apostrophe, but it debugged: Compile Error: Expected: End of statement

 

[ExcelSpeedster]

Try it without the "Call". So just "UpdateProgressBar PctDone" (without the quotes).

 

[RoryA]

FYI, if you use Call, you need brackets around the argument(s), like this:

Call UpdateProgressBar(PctDone)

Otherwise, as mentioned, just omit the Call:

UpdateProgressBar PctDone

Also, please learn to use code tags when posting code. The simplest way is to select all the code and then press the # button, or you can manually add [code] before the code and [/code] after it.

 

[LeanneBG]

Try it without the "Call". So just "UpdateProgressBar PctDone" (without the quotes).

It worked, but i am not seeing any userform/progress status can you help check my workbook attached if i did it correctly? When i click create reports, the userform is not showing


https://www.dropbox.com/s/fu36o9p450mc3bw/WD5 Actuals Line Item_V2.3.xlsm?dl=0

- Link of the Workbook