asked on

VBA format with leading Zero's on save file

I have the below code that works fine, however i am trying to amend th code to no avail so that it saves the files with the leading Zeros.

the number element are store numbers and it ranges from 1 - 168

ideally if possible can you advise how do i change the code so it saves the output files like the below example if a store number is 2 digits and the 3 digits etc.

0001
0010
0120

Sub GenerateOutput()

    Dim i As Long
    Dim iGradeRow As Long
    Dim iGradeCol As Long
    Dim iPosSeqRow As Long

    Dim s(1 To 7) As String

    Dim aGradeData() As Variant
    Dim aPosSeq() As Variant

    Dim aOutput(1 To 500000, 1 To 12) As Variant
    Dim iNextOutputRow As Long

    Dim ExportWorkbook As Workbook

    Dim Site As String
    Dim Department As String
    Dim Category As String
    Dim ArticleGrade As String
    Dim dp As String
    Dim ct As String
    Dim posQty As Long
    Dim y As Long
    Dim lrStores As Long
    Dim recordId As Long
    Dim selId As Long

    '------------------------

    Application.ScreenUpdating = False

    ' Get arrays of data to loop round
    With ws_Grades
        aGradeData = .Cells(1, 1).Resize(.Cells(.Rows.Count, 1).End(xlUp).Row, .Cells(1, .Columns.Count).End(xlToLeft).Column).Value2
    End With
    With ws_PosSeq
        aPosSeq = .Cells(1, 1).Resize(.Cells(.Rows.Count, 1).End(xlUp).Row, 20).Value2
    End With

    s(1) = "( "
    's(2) = iGradeRow - 3
    s(3) = " / "
    's(4) = UBound(aGradeData, 1) - 3
    s(5) = " ) "
    's(6) = "Collecting data for: "
    's(7) = aGradeData(iGradeRow, 2)
    'Application.StatusBar = Join(s)
    'DoEvents: DoEvents

    'check the departments and categories
    For iGradeRow = 4 To UBound(aGradeData, 1)

        's(1) = "( "
        s(2) = iGradeRow - 3
        's(3) = " / "
        s(4) = UBound(aGradeData, 1) - 3
        's(5) = " ) "
        s(6) = "Collecting data for: "
        s(7) = aGradeData(iGradeRow, 2)
        Application.StatusBar = Join(s)
        DoEvents: DoEvents
        Application.ScreenUpdating = False

        Erase aOutput
        iNextOutputRow = 1

        For iGradeCol = 3 To UBound(aGradeData, 2)

            Site = aGradeData(iGradeRow, 1)
            Department = aGradeData(1, iGradeCol)
            Category = aGradeData(3, iGradeCol)
            ArticleGrade = aGradeData(iGradeRow, iGradeCol)

            If iNextOutputRow = 1 Then
                recordId = 1
                selId = 1
            Else
                recordId = aOutput(iNextOutputRow - 1, 1) + 1
                selId = aOutput(iNextOutputRow - 1, 2) + 1
            End If

            'check the departments & categories in the opened workbook
            For iPosSeqRow = 3 To UBound(aPosSeq, 1)

                'if there is nil in the first column, go to the next loop
                If aPosSeq(iPosSeqRow, 1) = 0 Then GoTo NextDepartment

                'if the department name and category name matches:
                If (Trim(LCase(aPosSeq(iPosSeqRow, 2))) = Trim(LCase(Department))) And (Trim(LCase(aPosSeq(iPosSeqRow, 3))) = Trim(LCase(Category))) Then

                    dp = aPosSeq(iPosSeqRow, 2)
                    ct = aPosSeq(iPosSeqRow, 3)

                    'check wether the grades match:
                    If Not Trim(LCase(aPosSeq(iPosSeqRow, 6))) = Trim(LCase(ArticleGrade)) Then GoTo NextValue

                    'check pos qty:
                    posQty = aPosSeq(iPosSeqRow, 12)

                    'check department: same like the last one?:

                    If Not iNextOutputRow = 1 Then

                        If Trim(LCase(aOutput(iNextOutputRow - 2, 7))) = Trim(LCase(Site)) And _
                           Trim(LCase(aOutput(iNextOutputRow - 2, 5))) = Trim(LCase(dp)) And _
                           Trim(LCase(aOutput(iNextOutputRow - 2, 6))) = Trim(LCase(ct)) Then GoTo Level3

                        If Trim(LCase(aOutput(iNextOutputRow - 2, 7))) = Trim(LCase(Site)) And _
                           Trim(LCase(aOutput(iNextOutputRow - 2, 5))) = Trim(LCase(dp)) And _
                           Trim(LCase(aOutput(iNextOutputRow - 2, 6))) <> Trim(LCase(ct)) Then GoTo Level2

                        If Trim(LCase(aOutput(iNextOutputRow - 2, 7))) = Trim(LCase(Site)) And _
                           Trim(LCase(aOutput(iNextOutputRow - 2, 5))) <> Trim(LCase(dp)) And _
                           Trim(LCase(aOutput(iNextOutputRow - 2, 6))) <> Trim(LCase(ct)) Then GoTo Level2

                    End If

Level1:

                    ' Record Id
                    aOutput(iNextOutputRow, 1) = iNextOutputRow
                    ' SEL_ID
                    aOutput(iNextOutputRow, 2) = selId
                    ' Front + Back
                    aOutput(iNextOutputRow, 3) = "F"
                    ' Template_Type
                    aOutput(iNextOutputRow, 4) = "Store"
                    ' Store No
                    aOutput(iNextOutputRow, 7) = Site

                    iNextOutputRow = iNextOutputRow + 1

                    ' Record Id
                    aOutput(iNextOutputRow, 1) = iNextOutputRow
                    ' SEL_ID
                    aOutput(iNextOutputRow, 2) = selId
                    ' Back
                    aOutput(iNextOutputRow, 3) = "B"
                    ' Template_Type
                    aOutput(iNextOutputRow, 4) = "Store"
                    ' Store No
                    aOutput(iNextOutputRow, 7) = Site

                    iNextOutputRow = iNextOutputRow + 1

Level2:

                    'Record Id
                    aOutput(iNextOutputRow, 1) = iNextOutputRow
                    'SEL_ID
                    aOutput(iNextOutputRow, 2) = aOutput(iNextOutputRow - 1, 2) + 1
                    'Front_Back
                    aOutput(iNextOutputRow, 3) = "F"
                    'Template_Type
                    aOutput(iNextOutputRow, 4) = "Category"
                    'Department
                    aOutput(iNextOutputRow, 5) = dp
                    'Category
                    aOutput(iNextOutputRow, 6) = ct
                    'Store No
                    aOutput(iNextOutputRow, 7) = Site

                    iNextOutputRow = iNextOutputRow + 1

                    'Record Id
                    aOutput(iNextOutputRow, 1) = iNextOutputRow
                    'SEL_ID
                    aOutput(iNextOutputRow, 2) = aOutput(iNextOutputRow - 1, 2)
                    'Front_Back
                    aOutput(iNextOutputRow, 3) = "B"
                    'Template_Type
                    aOutput(iNextOutputRow, 4) = "Category"
                    'Department
                    aOutput(iNextOutputRow, 5) = dp
                    'Category
                    aOutput(iNextOutputRow, 6) = ct
                    'Store No
                    aOutput(iNextOutputRow, 7) = Site

                    iNextOutputRow = iNextOutputRow + 1

Level3:

                    For i = 1 To posQty

                        'Record Id
                        aOutput(iNextOutputRow, 1) = iNextOutputRow
                        'SEL_ID
                        If i = 1 Then
                            aOutput(iNextOutputRow, 2) = aOutput(iNextOutputRow - 1, 2) + 1
                        Else
                            aOutput(iNextOutputRow, 2) = aOutput(iNextOutputRow - 1, 2)
                        End If
                        'Front_Back
                        aOutput(iNextOutputRow, 3) = "F"
                        'Template_Type
                        aOutput(iNextOutputRow, 4) = "SEL"
                        'Department
                        aOutput(iNextOutputRow, 5) = dp
                        'Category
                        aOutput(iNextOutputRow, 6) = ct
                        'Store No
                        aOutput(iNextOutputRow, 7) = Site
                        'Barcode No
                        aOutput(iNextOutputRow, 8) = aPosSeq(iPosSeqRow, 8)
                        'Article Description
                        aOutput(iNextOutputRow, 9) = aPosSeq(iPosSeqRow, 7)
                        'WasWas
                        aOutput(iNextOutputRow, 10) = aPosSeq(iPosSeqRow, 13)
                        'Was
                        aOutput(iNextOutputRow, 11) = aPosSeq(iPosSeqRow, 14)
                        'Now
                        aOutput(iNextOutputRow, 12) = aPosSeq(iPosSeqRow, 16)

                        iNextOutputRow = iNextOutputRow + 1

                        'Record Id
                        aOutput(iNextOutputRow, 1) = iNextOutputRow
                        'SEL_ID
                        aOutput(iNextOutputRow, 2) = aOutput(iNextOutputRow - 1, 2)
                        'Front_Back
                        aOutput(iNextOutputRow, 3) = "B"
                        'Template_Type
                        aOutput(iNextOutputRow, 4) = "SEL"
                        'Department
                        aOutput(iNextOutputRow, 5) = dp
                        'Category
                        aOutput(iNextOutputRow, 6) = ct
                        'Store No
                        aOutput(iNextOutputRow, 7) = Site
                        'Barcode No
                        aOutput(iNextOutputRow, 8) = aPosSeq(iPosSeqRow, 8)
                        'Article Description
                        aOutput(iNextOutputRow, 9) = aPosSeq(iPosSeqRow, 7)

                        iNextOutputRow = iNextOutputRow + 1

                    Next i

                End If
NextValue:
            Next iPosSeqRow
NextDepartment:

        Next iGradeCol

        's(1) = "( "
        's(2) = iGradeRow - 3
        's(3) = " / "
        's(4) = UBound(aGradeData, 1) - 3
        's(5) = " ) "
        s(6) = "Generating export for: "
        's(7) = aGradeData(iGradeRow, 2)
        Application.StatusBar = Join(s)
        DoEvents: DoEvents
        Application.ScreenUpdating = False

        ' Clean output data
        For i = 1 To iNextOutputRow
            aOutput(i, 1) = Format(aOutput(i, 1), "0000000")
            aOutput(i, 2) = Format(aOutput(i, 2), "0000000")
            aOutput(i, 7) = Format(aOutput(i, 7), "0000")
            aOutput(i, 8) = "'" & aOutput(i, 8)
        Next i

        ws_Output.Cells(2, 1).Resize(ws_Output.UsedRange.Rows.Count, 12).ClearContents
        ws_Output.Cells(2, 1).Resize(iNextOutputRow, 12).Value2 = aOutput
        Application.ScreenUpdating = False
        If ExportWorkbook Is Nothing Then
            Set ExportWorkbook = Workbooks.Add
            ThisWorkbook.Activate
        End If
        Application.ScreenUpdating = False
        ExportWorkbook.Worksheets(1).Cells.Clear
        ws_Output.UsedRange.Copy
        ExportWorkbook.Worksheets(1).Cells(1, 1).PasteSpecial xlPasteAll
        Application.CutCopyMode = False
        ExportWorkbook.SaveCopyAs ThisWorkbook.Path & Application.PathSeparator & aGradeData(iGradeRow, 1) & "_" & aGradeData(iGradeRow, 2) & "_" & Format(Now(), "ddmmyyyy_hhmm") & ".xlsx"
        ws_Output.Cells(2, 1).Resize(ws_Output.UsedRange.Rows.Count, 12).ClearContents

    Next iGradeRow

EndingSub:

    ExportWorkbook.Close False
    Set ExportWorkbook = Nothing

    Application.StatusBar = False
    Application.ScreenUpdating = True

    MsgBox "Generated Workbooks.", vbInformation

End Sub

Open in new window

Subodh Tiwari (Neeraj)

You can use VBA Format function.
Replace the YourIntVariable in the below line with your actual variable which holds the integer part in the filename.

Format(YourIntVariable, "0000")

Open in new window

Roy Cox

Do you mean like this

ExportWorkbook.SaveCopyAs ThisWorkbook.Path & Application.PathSeparator & aGradeData(iGradeRow, 1) & "_" & [b]Format(aGradeData(iGradeRow, 2),"0000") [/b]& "_" & Format(Now(), "ddmmyyyy_hhmm") & ".xlsx"

Open in new window

zack carter

ASKER

I Ray,

I have tried your code and its bugging on your code. not sure why from:

Format(aGradeData(iGradeRow, 2),"0000")
& "_" & Format(Now(), "ddmmyyyy_hhmm") & ".xlsx"

Roy Cox

Is that the correct part to format as 0000 - aGradeData(iGradeRow, 2)?

What error message are you getting, possibly attach the workbook

zack carter

ASKER

Hi Subodh Tiwari (Neeraj)

I have tried changing the YourIntVariable as well and it hasn't worked on my end.

is there something i have missed, what line of the code should i amend per your advice?

ASKER CERTIFIED SOLUTION

Ryan Chong

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

zack carter

ASKER

Thank you all for your assistance, you don't know how long i have been searching online for a solution.

i amended this line of code and it worked:

Format(aGradeData(iGradeRow, 1), "0000")

Ryan Chong

@zack carter

are you accepting the correct comment as the answer?

I'm just agreed with others that format function should work and I'm not the first to mention that.