VBA learner ITG
Active Member
- Joined
- Apr 18, 2017
- Messages
- 272
- Office Version
- 365
- Platform
- Windows
- MacOS
Hi Experts,
I need your guidance please.
I was wodnering if anyone knows how i can enhance the below code to generate folders based on the output file name and move the output file into the folder that is created.
- The code generates multiple excel files in the below format "Store Number_Store Name_Date_Time"
EXAMPLE:
0010_LONDON_03102017_1601
I need your guidance please.
I was wodnering if anyone knows how i can enhance the below code to generate folders based on the output file name and move the output file into the folder that is created.
- The code generates multiple excel files in the below format "Store Number_Store Name_Date_Time"
EXAMPLE:
0010_LONDON_03102017_1601
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 14) 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"
'zack
'Template_Type
aOutput(iNextOutputRow, 4) = aPosSeq(iPosSeqRow, 9)
'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)
'zack
'Our Price
aOutput(iNextOutputRow, 13) = aPosSeq(iPosSeqRow, 17)
'RRP Price
aOutput(iNextOutputRow, 14) = aPosSeq(iPosSeqRow, 18)
iNextOutputRow = iNextOutputRow + 1
'Record Id
aOutput(iNextOutputRow, 1) = iNextOutputRow
'SEL_ID
aOutput(iNextOutputRow, 2) = aOutput(iNextOutputRow - 1, 2)
'Front_Back
aOutput(iNextOutputRow, 3) = "B"
'zack
'Template_Type
aOutput(iNextOutputRow, 4) = aPosSeq(iPosSeqRow, 9)
'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)
'ZACK AMENDED CODE
'WasWas
aOutput(iNextOutputRow, 10) = aPosSeq(iPosSeqRow, 13)
'Was
aOutput(iNextOutputRow, 11) = aPosSeq(iPosSeqRow, 14)
'Now
aOutput(iNextOutputRow, 12) = aPosSeq(iPosSeqRow, 16)
'zack
'Our Price
aOutput(iNextOutputRow, 13) = aPosSeq(iPosSeqRow, 17)
'RRP Price
aOutput(iNextOutputRow, 14) = aPosSeq(iPosSeqRow, 18)
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, 14).ClearContents
ws_Output.Cells(2, 1).Resize(iNextOutputRow, 14).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, 14).ClearContents
Next iGradeRow
EndingSub:
ExportWorkbook.Close False
Set ExportWorkbook = Nothing
Application.StatusBar = False
Application.ScreenUpdating = True
MsgBox "Generated Workbooks.", vbInformation
End sub
