VBA amend code help!

VBA learner ITG

Active Member
Joined
Apr 18, 2017
Messages
272
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS
Hello my peers.

I have tried to amend the code to no avail and i cant seem to find a solution through searching through forums and google to resolve my issue.

The below code will name the output files each time it saves it with "SEL" in the Template Type Column on the output sheets.

However instead of saying "SEL" could it take the cell value so its not hard coded to "SEL".

the Value in the cell could be "SEL" or "DST" or "EHL".

Code:
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) = " "
                        '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) = " "
                        '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 & Format(aGradeData(iGradeRow, 1), "0000") & "_" & 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
 

Excel Facts

How to show all formulas in Excel?
Press Ctrl+` to show all formulas. Press it again to toggle back to numbers. The grave accent is often under the tilde on US keyboards.
Just to Give you some further information:

[FONT=&quot]SEL goes into each saved workbook under column D under "Template_Type".[/FONT]

[FONT=&quot]This is the cause of my issue as the origional Template data might be SEL or DHT or 1234 and i have spent all morning trying to amend it to reflect this variable data.[/FONT]

[FONT=&quot]The Code is referenced to POS Sequence which is under Column I POS type.[/FONT]
 
Upvote 0

Forum statistics

Threads
1,223,909
Messages
6,175,313
Members
452,634
Latest member
cpostell

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
Back
Top