Forecasting

Sub forecasting()

 Dim last_ie As Long, supplier() As String, a As Long, supplier_range As Range

    If ThisWorkbook.Worksheets("Macro").Range("BA1").Value = "All suppliers not mapped" Then
        MsgBox "Please refer to the supplier mapping sheet. All suppliers are not mapped."
        Exit Sub
    End If
  Worksheets("Final FC").Range("A2:A10000").ClearContents
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'IE
    ThisWorkbook.Worksheets("IE").Activate

    last_ie = ThisWorkbook.Worksheets("IE").Cells(Rows.Count, 1).End(xlUp).Row

    ThisWorkbook.Worksheets("IE").Range("B1").EntireColumn.Insert
    ThisWorkbook.Worksheets("IE").Range("H1").EntireColumn.Insert
    ThisWorkbook.Worksheets("IE").Range("AF2:AF" & last_ie).Copy
    ThisWorkbook.Worksheets("IE").Range("Q2:Q" & last_ie).PasteSpecial Paste:=xlPasteValues

    ThisWorkbook.Worksheets("IE").Range("AG2:AG" & last_ie).Copy
    ThisWorkbook.Worksheets("IE").Range("H2:H" & last_ie).PasteSpecial Paste:=xlPasteValues

    ThisWorkbook.Worksheets("IE").Range("AC2:AC" & last_ie).Copy
        ThisWorkbook.Worksheets("IE").Range("B2:B" & last_ie).PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False


    If ActiveSheet.AutoFilterMode = False Then
        ThisWorkbook.Worksheets("IE").Range("$A$1:$AJ$" & last_ie).AutoFilter
    End If

        ActiveSheet.Range("$A$1:$AJ$" & last_ie).AutoFilter Field:=17, Criteria1:="1"
  On Error Resume Next
    ActiveSheet.Range("$A$1:$AJ$" & last_ie).Offset(1, 0).SpecialCells _
    (xlCellTypeVisible).EntireRow.Delete

  On Error GoTo 0

  If ActiveSheet.FilterMode = True Then
    ActiveSheet.ShowAllData
  End If
    last_ie = ThisWorkbook.Worksheets("IE").Cells(Rows.Count, 1).End(xlUp).Row
 i = 0
For a = 2 To last_ie

    If InStr(ThisWorkbook.Worksheets("IE").Cells(a, 15).Value, "/") Then
        ThisWorkbook.Worksheets("IE").Cells(a, 15).Value = Replace(ThisWorkbook.Worksheets("IE").Cells(a, 15).Value, "/", " ")
    ElseIf InStr(ThisWorkbook.Worksheets("IE").Cells(a, 15).Value, "\") Then
        ThisWorkbook.Worksheets("IE").Cells(a, 15).Value = Replace(ThisWorkbook.Worksheets("IE").Cells(a, 15).Value, "\", " ")
    ElseIf InStr(ThisWorkbook.Worksheets("IE").Cells(a, 15).Value, """") Then
        ThisWorkbook.Worksheets("IE").Cells(a, 15).Value = Replace(ThisWorkbook.Worksheets("IE").Cells(a, 15).Value, """", " ")
    ElseIf InStr(ThisWorkbook.Worksheets("IE").Cells(a, 15).Value, ":") Then
        ThisWorkbook.Worksheets("IE").Cells(a, 15).Value = Replace(ThisWorkbook.Worksheets("IE").Cells(a, 15).Value, ":", " ")
    ElseIf InStr(ThisWorkbook.Worksheets("IE").Cells(a, 15).Value, "*") Then
        ThisWorkbook.Worksheets("IE").Cells(a, 15).Value = Replace(ThisWorkbook.Worksheets("IE").Cells(a, 15).Value, "*", " ")
    ElseIf InStr(ThisWorkbook.Worksheets("IE").Cells(a, 15).Value, "?") Then
        ThisWorkbook.Worksheets("IE").Cells(a, 15).Value = Replace(ThisWorkbook.Worksheets("IE").Cells(a, 15).Value, "?", " ")
    ElseIf InStr(ThisWorkbook.Worksheets("IE").Cells(a, 15).Value, ">") Then
        ThisWorkbook.Worksheets("IE").Cells(a, 15).Value = Replace(ThisWorkbook.Worksheets("IE").Cells(a, 15).Value, ">", " ")
    ElseIf InStr(ThisWorkbook.Worksheets("IE").Cells(a, 15).Value, "<") Then
        ThisWorkbook.Worksheets("IE").Cells(a, 15).Value = Replace(ThisWorkbook.Worksheets("IE").Cells(a, 15).Value, "<", " ")
    ElseIf InStr(ThisWorkbook.Worksheets("IE").Cells(a, 15).Value, "|") Then
        ThisWorkbook.Worksheets("IE").Cells(a, 15).Value = Replace(ThisWorkbook.Worksheets("IE").Cells(a, 15).Value, "|", " ")
    End If

  If i = 0 Then
    ReDim supplier(0)
        supplier(0) = ThisWorkbook.Worksheets("IE").Cells(a, 15).Value
        i = i + 1
  ElseIf i <> 0 Then
    If IsError(Application.Match(ThisWorkbook.Worksheets("IE").Cells(a, 15).Value, supplier, 0)) Then
       ReDim Preserve supplier(0 To i)
       supplier(i) = ThisWorkbook.Worksheets("IE").Cells(a, 15).Value
       i = i + 1
    End If
  End If
Next

For a = 0 To i - 1
If supplier(a) <> "" Then
  Workbooks.Open ThisWorkbook.Path & "\Working template.xlsx"
  ActiveWorkbook.SaveAs ThisWorkbook.Path & "\Templates\" & supplier(a) & ".xlsx"
  If ThisWorkbook.Worksheets("IE").FilterMode = True Then
    ThisWorkbook.Worksheets("IE").ShowAllData
  End If
    ThisWorkbook.Worksheets("IE").Range("$A$1:$AJ$" & last_ie).AutoFilter Field:=15, Criteria1:=supplier(a)
   ThisWorkbook.Worksheets("IE").Range("A2:Q" & last_ie).SpecialCells(xlCellTypeVisible).Copy
   rowz = ThisWorkbook.Worksheets("IE").AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count - 1
   Workbooks(supplier(a)).Activate
   Workbooks(supplier(a)).Worksheets(1).Range("A4:Q" & 3 + rowz).PasteSpecial

   ThisWorkbook.Worksheets("IE").Range("R2:T" & last_ie).SpecialCells(xlCellTypeVisible).Copy
   Workbooks(supplier(a)).Activate
   Workbooks(supplier(a)).Worksheets(1).Range("V4:X" & 3 + rowz).PasteSpecial

   For b = 4 To 3 + rowz
    If Workbooks(supplier(a)).Worksheets(1).Cells(b, 17).Value = "2" Then
        Workbooks(supplier(a)).Worksheets(1).Cells(b, 17).Value = "TBC"
    End If
   Next

   Workbooks(supplier(a)).Worksheets(1).Range("A" & 4 + rowz & ":AD100").ClearContents
   Workbooks(supplier(a)).Save
   Workbooks(supplier(a)).Close
   End If
Next

ThisWorkbook.Worksheets("Final FC").Range("A2:A" & i + 1).Value = Application.Transpose(supplier)
ThisWorkbook.Worksheets("IE").Activate

Set supplier_ie = ThisWorkbook.Worksheets("Final FC").Range("A2:A" & i + 1)
  If ActiveSheet.FilterMode = True Then
    ActiveSheet.ShowAllData
  End If