Sub file_open()
'fasting settings
Application.Calculation = xlManual
Application.ScreenUpdating = False
 
Dim wb_base_name As String, rinok_nash_order_column As Integer, ordernum As String, ws_base_name As String, wb_order_name As String, ws_order_name As String, wb As Workbook, ws As Worksheet, model(9999) As String, color(9999) As String, quantity(9999) As Integer, position(9999) As Integer, skin(9999) As Integer, skinrow(9999) As Integer, modwcolor As String, numrow As Integer, cur_sym_pos As Integer, order_column As Integer, filename As String, lrib As Integer
 
'open file dialog window
ChDir ThisWorkbook.Path & "\"
impfilename = Application.GetOpenFilename("Excel files(*.xls*),*.xls*", 2, "Выбрать текстовые или Excel файлы", , False)
If impfilename = "False" Then Exit Sub
 
wb_base_name = ActiveWorkbook.Name
ws_base_name = ActiveWorkbook.ActiveSheet.Name
 
Set wb = Application.Workbooks.Open(impfilename)
filename = wb.Name
wb_order_name = wb.Name
For Each ws In wb.Worksheets
    ws_order_name = ws.Name
    'from managers
     
     
    'detect columns nums
    Dim col_num_nazv, col_num_model, col_num_kol, col_num_last As Integer
    For q = 1 To 99
        If Right(ws.Cells(1, q), 6) = "Модель" Then col_num_model = q
        If Right(ws.Cells(1, q), 10) = "Количество" Then col_num_kol = q
        If ws.Cells(1, q) <> "" Then col_num_last = q
    Next q
 
 
    If col_num_nazv <> "" And col_num_model <> "" Then
        from_manager = True
        For i = 1 To Len(wb.Name)
                If IsNumeric(Mid(wb.Name, i, 1)) Then ordernum = ordernum + Mid(wb.Name, i, 1)
                If Mid(wb.Name, i, 1) = " " And Len(ordernum) > 0 Then Exit For
        Next i
        filename = "№" + ordernum + "-"
         
         
        'reading order
        For numrow = 2 To 9999
            If ws.Cells(numrow, col_num_model) = "" Then Exit For
                If Len(ws.Cells(numrow, col_num_model)) = 1 Then model(numrow - 1) = "0000" + CStr(ws.Cells(numrow, col_num_model))
                If Len(ws.Cells(numrow, col_num_model)) = 2 Then model(numrow - 1) = "000" + CStr(ws.Cells(numrow, col_num_model))
                If Len(ws.Cells(numrow, col_num_model)) = 3 Then model(numrow - 1) = "00" + CStr(ws.Cells(numrow, col_num_model))
                If Len(ws.Cells(numrow, col_num_model)) = 4 Then model(numrow - 1) = "0" + CStr(ws.Cells(numrow, col_num_model))
                If Len(ws.Cells(numrow, col_num_model)) = 5 Or Len(ws.Cells(numrow, 2)) = 7 Then model(numrow - 1) = ws.Cells(numrow, col_num_model)
                quantity(numrow - 1) = Int(ws.Cells(numrow, col_num_kol))
             
            modwcolor = ws.Cells(numrow, col_num_nazv)
             
            If Left(ws.Cells(1, col_num_nazv), 1) <> "*" And Left(ws.Cells(1, col_num_nazv), 2) <> "ш-" Then skin(numrow - 1) = 0
            If Left(ws.Cells(1, col_num_nazv), 1) = "*" Then skin(numrow - 1) = 1
            If Left(ws.Cells(1, col_num_nazv), 2) = "ш-" Then skin(numrow - 1) = 2
            'selecting color from modwcolor
            For cur_sym_pos = Len(modwcolor) - 1 To 1 Step -1
                If IsNumeric(Mid(modwcolor, cur_sym_pos, 1)) Or Mid(modwcolor, cur_sym_pos, 1) = "-" Then
                    color(numrow - 1) = Right(modwcolor, Len(modwcolor) - cur_sym_pos)
                    Exit For
                End If
            Next cur_sym_pos
            color(numrow - 1) = UCase(Replace(color(numrow - 1), " ", ""))
        Next numrow
 
         
        numrow = numrow - 2
        lrib = last_row_in_base(wb_base_name, ws_base_name)
        order_column = new_order(wb_base_name, ws_base_name, filename, lrib)
        filename = filename + CStr(find_containers(model, color, quantity, position, skin, skinrow, numrow, wb_base_name, ws_base_name, lrib, order_column, wb_order_name, ws_order_name, "manager", rinok_nash_order_column)) + "шт-Резерв-" + InputBox("Введите инициалы менеджера", "Запрос")
        numrow = numrow + 1
 
 
             
            Workbooks(wb_order_name).Activate
            Worksheets(ws_order_name).Activate
            ws.Range(Cells(1, col_num_last + 1).Address, Cells(numrow, col_num_last + 1).Address).Copy ws.Cells(1, 30)
            ws.Cells(1, 30) = "Не отгружено"
            ws.Range(Cells(1, col_num_nazv).Address, Cells(numrow, col_num_nazv).Address).Copy ws.Cells(1, 27)
            ws.Range(Cells(1, col_num_kol).Address, Cells(numrow, col_num_kol).Address).Copy ws.Cells(1, 28)
            ws.Range(Cells(1, col_num_last).Address, Cells(numrow, col_num_last).Address).Copy ws.Cells(1, 29)
            ws.Cells(1, 29) = "Отгружено"
            ws.Range("AA1:AA" + CStr(numrow) + ",AB1:AB" + CStr(numrow) + ",AC1:AC" + CStr(numrow) + ",AD1:AD" + CStr(numrow)).Copy
            'ws.Range("AA1:AA99999,AB1:AB99999,AC1:AC99999,AD1:AD99999").Copy
        Workbooks.Add
        ActiveSheet.Paste Destination:=Range("A1")
        Application.DisplayAlerts = False
        Rows("1:1000").RowHeight = 15
        Columns("A:H").AutoFit
        'Cells(numrow + 1, 3) = "=СУММ(C2:C" + CStr(numrow) + ")"
        Cells(numrow + 1, 4) = Application.WorksheetFunction.Sum(Columns("D:D"))
        Cells(numrow + 1, 3) = Application.WorksheetFunction.Sum(Columns("C:C"))
        'Cells(numrow + 1, 2) = "=СУММ(B2:B" + CStr(numrow) + ")"
        Cells(numrow + 1, 2) = Application.WorksheetFunction.Sum(Columns("B:B"))
        ActiveWorkbook.SaveAs _
        filename:=".\отправка\" + filename + ".xlsx"
        ActiveWorkbook.Close
        Application.DisplayAlerts = True
 
         
        Workbooks(wb_base_name).Activate
        Worksheets(ws_base_name).Activate
        Cells(1, order_column) = filename
        Workbooks(wb_order_name).Activate
        Worksheets(ws_order_name).Activate
        GoTo labelexit
         
    End If
 
wb.Close (0)
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
End Sub
Function last_row_in_base(wb_base_name As String, ws_base_name As String) As Integer
    Workbooks(wb_base_name).Activate
    Worksheets(ws_base_name).Activate
    'find last row
    For i = 9999 To 1 Step -1
        If Cells(i, 16) <> "" Then last_row_in_base = i: Exit For
    Next i
End Function
 
Function new_order(wb_base_name As String, ws_base_name As String, filename As String, lrib As Integer) As Integer
    Workbooks(wb_base_name).Activate
    Worksheets(ws_base_name).Activate
    'find last column
    For i = 28 To 9999
        If Cells(2, i) <> "" And Cells(3, i) <> "" And Cells(4, i) <> "" And Cells(5, i) <> "" Then new_order = i + 1
    Next i
    'copy previous columns to new order
    Cells(2, new_order) = Format(Date, "dd\/mm")
    Cells(2, new_order + 1) = Format(Date, "mm\/dd")
    Cells(2, new_order + 2) = Format(Date, "dd\/mm")
    Cells(2, new_order + 3) = Format(Date, "mm\/dd")
    Cells(1, new_order).Interior.color = 65535
    Cells(2, new_order).Interior.color = 65535
    Cells(1, new_order + 2).Interior.color = 65535
    Cells(2, new_order + 2).Interior.color = 65535
 
    For i = 3 To lrib
        Cells(i, new_order).Interior.color = 65535
        Cells(i, new_order + 1) = "=RC[-2]-RC[-1]"
        Cells(i, new_order + 2).Interior.color = 65535
        Cells(i, new_order + 3) = "=RC[-2]-RC[-1]"
    Next i
End Function
Function find_containers(model() As String, color() As String, quantity() As Integer, position() As Integer, skin() As Integer, skinrow() As Integer, numrow As Integer, wb_base_name As String, ws_base_name As String, lrib As Integer, order_column As Integer, wb_order_name As String, ws_order_name As String, order_type As String, rinok_nash_order_column As Integer) As Integer
    Dim text As String, all_cont_sum As Integer
    Workbooks(wb_base_name).Activate
    Worksheets(ws_base_name).Activate
    Dim containers(99, 2) As Integer
    Dim cont_num As Integer, quantity_sum As Integer, balance As Integer, container_found As Boolean, skirow_found As Boolean, skincolumnplus As Integer
 
    For i = 1 To numrow
        Erase containers
        container_found = False
        skinrow_found = False
        cont_num = 0
        quantity_sum = 0
        skincolumnplus = 0
        balance = 0
 
        'run across all containers
       For baserow = 1 To lrib
 
        'calculate skincolumnplus
        If skin(i) = 1 Or (order_type = "manager" And skinrow_found = True And skin(i) <> 2) Then skincolumnplus = 2
 
        'sorting containers massive
        Dim tmp As Integer, tmp2 As Integer
        For isrt = 1 To cont_num - 1
            For jsrt = 1 To cont_num - isrt
                If containers(jsrt, 2) > containers(jsrt + 1, 2) Then
                    tmp = containers(jsrt, 1)
                    tmp2 = containers(jsrt, 2)
                    containers(jsrt, 1) = containers(jsrt + 1, 1)
                    containers(jsrt, 2) = containers(jsrt + 1, 2)
                    containers(jsrt + 1, 1) = tmp
                    containers(jsrt + 1, 2) = tmp2
                    End If
            Next jsrt
        Next isrt
 
        'if skinrow not found, writing to the order and going to next orderrow
        If skin(i) <> 0 And skinrow_found = False Then
            Workbooks(wb_order_name).Activate
            Worksheets(ws_order_name).Activate
            If order_type = "manager" Then
                If Cells(1, 6) = "Количество" Then
                    Cells(i + 1, 8) = Cells(i + 1, 8) + 0
                    Cells(i + 1, 8).Interior.color = 255
                    Cells(i + 1, 9) = Cells(i + 1, 9) + quantity(i)
                    Cells(i + 1, 9).Interior.color = 255
                Else
                    Cells(i + 1, 9) = Cells(i + 1, 9) + 0
                    Cells(i + 1, 9).Interior.color = 255
                    Cells(i + 1, 10) = Cells(i + 1, 10) + quantity(i)
                    Cells(i + 1, 10).Interior.color = 255
 
                End If
 
            Workbooks(wb_base_name).Activate
            Worksheets(ws_base_name).Activate
            GoTo nexi
        End If
 
                 
        'if all container quantity is enought
        If quantity_sum >= quantity(i) Then
            'search postion in one container
            For isrt = 1 To cont_num
                If containers(isrt, 2) >= quantity(i) Then
                    'write to container to order in base
                    Cells(containers(isrt, 1), order_column + skincolumnplus) = Cells(containers(isrt, 1), order_column + skincolumnplus) + quantity(i)
                    'write data to skinrow
                    If (skin(i) = 1 And skinrow_found = True) Or (order_type = "manager" And skinrow_found = True And skin(i) <> 2) Then
                        Cells(skinrow(i), order_column) = Cells(skinrow(i), order_column) + quantity(i)
                        Cells(skinrow(i), order_column + 2) = Cells(skinrow(i), order_column + 2) - quantity(i)
                    End If
 
                    container_found = True
                    Exit For
                End If
            Next isrt
 
 
            If quantity_sum = 0 Then
             
                'write zero to base
                If containers(0, 1) > 0 Then If Cells(containers(0, 1), order_column + skincolumnplus) = "" Then Cells(containers(0, 1), order_column + skincolumnplus) = 0
                If (skin(i) = 1 And skinrow_found = True) Or (order_type = "manager" And skinrow_found = True And skin(i) <> 2) Then
                    Cells(skinrow(i), order_column) = Cells(skinrow(i), order_column) + 0
                    Cells(skinrow(i), order_column + 2) = Cells(skinrow(i), order_column + 2) - 0
                End If
  
 
nexi:
    Next i
find_containers = all_cont_sum
End Function
 
Sub file_import()
file_open
End Sub