Create Inquiry For Quotation

Option Explicit

Sub createMe()
    Dim finalLocation                   As String
    Dim fileLocation                    As String
    Dim lRow                            As Long
    Dim lStartRow                       As Long
    Dim lLastRow                        As Long
    
    Dim ifqTag                          As String
    Dim projectName                     As String
    Dim requestDate                     As String
    Dim engineer                        As String
    Dim dueDate                         As String
    
    Dim wbIFQ                           As Workbook
    Dim companyName                     As String
    Dim productname                     As String
    Dim contactPerson                   As String
    Dim phoneNumber                     As String
    Dim faxNumber                       As String
    Dim emailId                         As String
    Dim ifqNumber                       As String
  
    Dim temp                            As String
    
    ThisWorkbook.Activate
    
    Const QUOTE_FILE = "IFQ-IFQ Number-Company name.xlsx"
    
    fileLocation = ThisWorkbook.Path
    If (Right(fileLocation, 1) <> Application.PathSeparator) Then fileLocation = fileLocation & Application.PathSeparator
    fileLocation = fileLocation & QUOTE_FILE
    If (Dir(fileLocation) = vbNullString) Then
        MsgBox "unable to find file " & fileLocation
        Exit Sub
    End If
    
    
    lStartRow = getItemLocation("true", Columns(12), , False)
    If lStartRow = 0 Then
        MsgBox "There is nothing to generate"
        Exit Sub
    End If
    
    lLastRow = getItemLocation("true", Columns(12))
  
    ifqTag = InputBox("Enter IFQ Tag", "IFQ Tag")
    projectName = InputBox("Enter Project", "Project")
    requestDate = InputBox("Enter Request Date", "Request Date")
    engineer = InputBox("Enter Engineer Name", "Engineer Name")
    dueDate = InputBox("Enter Due By Date", "Due By")
    
    finalLocation = CreateObject("WScript.Shell").SpecialFolders("Desktop") & Application.PathSeparator & "IFQ - " & projectName & Application.PathSeparator
    temp = Dir(finalLocation, vbDirectory)
    If (temp = vbNullString) Then MkDir finalLocation
    
    ThisWorkbook.Activate
    For lRow = lStartRow To lLastRow
        ThisWorkbook.Activate
        If (Cells(lRow, "M") = True) Then
            companyName = Cells(lRow, "C")
            productname = Cells(lRow, "D")
            contactPerson = Cells(lRow, "F")
            phoneNumber = Cells(lRow, "G")
            faxNumber = Cells(lRow, "H")
            emailId = Cells(lRow, "J")
            ifqNumber = Cells(lRow, "K")
        

            Set wbIFQ = Workbooks.Open(fileLocation)
            wbIFQ.SaveAs finalLocation & ifqNumber & " - " & companyName
            
            wbIFQ.Sheets("Form-IFQ-34").Range("B17") = companyName
            wbIFQ.Sheets("Form-IFQ-34").Range("C18") = phoneNumber
            wbIFQ.Sheets("Form-IFQ-34").Range("C19") = faxNumber
            wbIFQ.Sheets("Form-IFQ-34").Range("D20") = emailId
            wbIFQ.Sheets("Form-IFQ-34").Range("B22") = contactPerson
            wbIFQ.Sheets("Form-IFQ-34").Range("A27") = productname
            wbIFQ.Sheets("Form-IFQ-34").Range("O16") = ifqTag & "/" & ifqNumber
             
             wbIFQ.Sheets("Form-IFQ-34").Range("B23") = requestDate
             wbIFQ.Sheets("Form-IFQ-34").Range("B24") = projectName
             wbIFQ.Sheets("Form-IFQ-34").Range("A35") = engineer
             wbIFQ.Sheets("Form-IFQ-34").Range("G50") = dueDate
            
            wbIFQ.Save
            wbIFQ.Close
            Set wbIFQ = Nothing
        End If
    Next
    
End Sub


Public Function getItemLocation(sLookFor As String, _
                                rngSearch As Range, _
                                Optional bFullString As Boolean = True, _
                                Optional bLastOccurance As Boolean = True, _
                                Optional bFindRow As Boolean = True) As Long
                                   
   'find the first/last row/column  within a range for a specific string
      
   Dim Cell             As Range
   Dim iLookAt          As Integer
   Dim iSearchDir       As Integer
   Dim iSearchOdr       As Integer
         
   If (bFullString) _
   Then
      iLookAt = xlWhole
   Else
      iLookAt = xlPart
   End If
   If (bLastOccurance) _
   Then
      iSearchDir = xlPrevious
   Else
      iSearchDir = xlNext
   End If
   If Not (bFindRow) _
   Then
      iSearchOdr = xlByColumns
   Else
      iSearchOdr = xlByRows
   End If
         
   With rngSearch
      If (bLastOccurance) _
      Then
         Set Cell = .Find(sLookFor, .Cells(1, 1), xlValues, iLookAt, iSearchOdr, iSearchDir)
      Else
         Set Cell = .Find(sLookFor, .Cells(.Rows.Count, .Columns.Count), xlValues, iLookAt, iSearchOdr, iSearchDir)
      End If
   End With
         
   If Cell Is Nothing Then
      getItemLocation = 0
   ElseIf Not (bFindRow) _
   Then
      getItemLocation = Cell.Column
   Else
      getItemLocation = Cell.Row
   End If
   Set Cell = Nothing

End Function