Option Explicit
Sub loadlists()
Dim myPath As String, Wb As Workbook, nRow As Long, llName As String, numRow As Long
Dim fromDate As Date, toDate As Date, curDate As Date, columnStart As Long, columnEnd As Long
Dim numSku As Long, Cust_id As String, CustLocCity As String, CustDest As String, CustCont As String
Dim qty As Long, skuN As String
Dim sht As Worksheet, sh As Worksheet
Dim sep As String
Dim ext As String
Dim nlists As Long
Dim col As Long
Dim WBO As Workbook
Dim SHO As Worksheet
Dim i As Long
Dim S As Long
Application.ScreenUpdating = False
numSku = 4 ' number of SKU
Set Wb = ActiveWorkbook
Set sh = Wb.ActiveSheet 'Master sheet
' Set sht = Wb.Sheets("template_load")
myPath = Wb.Path 'maybe use for save lists as separate files
sep = Application.PathSeparator
ext = ".xlsx"
nlists = 0 ' Number of created lists
nRow = sh.Cells(Rows.count, 4).End(xlUp).Row 'number of filled rows Customer at Master sheet
fromDate = sh.Range("fromDate")
toDate = sh.Range("toDate")
columnStart = findColumn(fromDate) 'column with from date
columnEnd = findColumn(toDate) 'column with to date
If columnStart > 0 And columnEnd > 0 Then
With sh
' loop for Date`s columns
For col = columnStart To columnEnd Step numSku ' Step = number of SKU
curDate = .Cells(3, col)
' Check if this date valid and filled at least one SKU:
' ToDo: need recreate this chesk when number of SKU wiil increased
If IsDate(curDate) _
And (.Cells(Rows.count, col).End(xlUp).Row > 4 _
Or .Cells(Rows.count, col + 1).End(xlUp).Row > 4 _
Or .Cells(Rows.count, col + 2).End(xlUp).Row > 4 _
Or .Cells(Rows.count, col + 3).End(xlUp).Row > 4) Then
llName = Format(curDate, "dd.mm.yyyy") 'name for load list like "02.09.2024"
' Create the New Workbook
On Error Resume Next
sht.Copy
If Err.Number = 0 Then
Set WBO = ActiveWorkbook
Set SHO = WBO.Sheets(1)
SHO.Name = llName ' Name Sheet
SHO.Visible = True ' Create it visible
WBO.SaveAs (myPath & sep & llName & ext)
Else
MsgBox ("Error creating new file")
Exit Sub
End If
On Error GoTo 0
' Clear sheet before fill it:
SHO.Range("A2:M" & SHO.Cells(Rows.count, 9).End(xlUp).Row).ClearContents
numRow = 1
sh.Activate
' loop for ID`s
For i = 5 To nRow
' fill Customer info
Cust_id = .Cells(i, 4)
CustLocCity = searchID(Cust_id, 2)
If CustLocCity = "-1" Then ' Not found this ID
MsgBox ("Customer " & Cust_id & " do not found in DICTIONARY! Please add it.")
Exit Sub
End If
CustDest = searchID(Cust_id, 3)
CustCont = searchID(Cust_id, 4)
' loop for SKU
For S = 1 To numSku
qty = .Cells(i, col + S - 1)
skuN = .Cells(4, col + S - 1)
If qty > 0 Then
SHO.Cells(numRow + 1, 2) = numRow
SHO.Cells(numRow + 1, 3) = CustLocCity
SHO.Cells(numRow + 1, 4) = CustDest
SHO.Cells(numRow + 1, 9) = curDate
SHO.Cells(numRow + 1, 10) = skuN
SHO.Cells(numRow + 1, 11) = qty
SHO.Cells(numRow + 1, 12) = Cust_id
SHO.Cells(numRow + 1, 13) = CustCont
numRow = numRow + 1
End If
Next S ' loop for SKU
Next i ' loop for ID`s
WBO.Save
WBO.Close
nlists = nlists + 1
End If ' Check if this date valid...
'Application.StatusBar = "Progress: " & col & " of " & columnEnd & ": " & Format(col / columnEnd, "Percent")
Next col ' loop for Date`s columns
End With
End If
'Application.StatusBar = False
sh.Activate
MsgBox ("Created " & nlists & " list(s).")
'Wb.Save
Application.ScreenUpdating = True
End Sub
Function findColumn(findDate As Date) As Long
Dim fDate As Range
Set fDate = ActiveWorkbook.ActiveSheet.Rows(3).Find(findDate, LookIn:=xlValues, lookat:=xlWhole)
If Not fDate Is Nothing Then
findColumn = fDate.column
Else
findColumn = -1
End If
End Function
Function searchID(Cust_id As String, colmn As Integer) As String
Dim fid As Range
With ActiveWorkbook.Sheets("DICTIONARY")
Set fid = .Columns(1).Find(Cust_id, LookIn:=xlValues, lookat:=xlWhole)
If Not fid Is Nothing Then
searchID = .Cells(fid.Row, colmn)
Else
searchID = "-1"
End If
End With
End Function
