Copy selected data range to newly created workbook.

[Falko26]

Hey Team,

I'm trying to run a macro that creates a Missing Materials Report based on a specific Job Number. What I want it to do is create a new workbook then copy all rows associated with a specific job number from the master workbook sheet "Open" to the new workbook. Then once the data is in the new workbook I want it to look at the material ordered and the material received. All rows where the material received is equal to or higher than the material ordered can be deleted. All rows with the Material received lower than the material ordered need to stay, then subtract the received from the ordered to get the quantity needed.

I was able to get a good start by creating a new workbook and saving with the correct file name. I'm just not sure how to take it forward from here.

The way it works currently is I select the Job Number from the %Received Tab in the Master then the workbook is created and saved into active workbook file path & \Reports Folder.
- See Link to Workbook.

https://badlandscont-my.sharepoint....RBvXKPlIWgar8BWqkxpxhqPkf0_62Km9V24w?e=rQdcok

At the very least if I could simply get it to copy all rows that have the selected job number over to the new workbook I can work with from there.

Sub BLC_JobNumber_Report()

    Dim foundCell As Range
    Dim firstAddress As String
    Dim searchRng As Range
    Dim thisWb As Workbook
    Dim selJobNr As String
    Dim selClient As String
    Dim selProj As String
    Dim NameBase As String
    
    selJobNr = ActiveSheet.Cells(ActiveCell.Row, "B").Value
    selClient = ActiveSheet.Cells(ActiveCell.Row, "C").Value
    selProj = ActiveSheet.Cells(ActiveCell.Row, "D").Value
    NameBase = Format(Date, "mm.dd.yyyy")
    
    userAnswer = MsgBox("Run missing material report for job number " & selJobNr & "?", vbQuestion + vbYesNo, "User Repsonse")
    
    If userAnswer = vbYes Then
        
    Set thisWb = ActiveWorkbook
    Workbooks.Add
    ActiveWorkbook.SaveAs Filename:=thisWb.Path & "\Reports\" & selJobNr & " " & selClient & " " & selProj & "- " & NameBase & ".xlsx"

    End If
End Sub

Thanks for the assistance,

 

[Falko26]

I'm going to try and simplify this question.

What I am trying to do is filter to a specific range then copy that filtered range to a new workbook that is also created in the Macro.

The Current Code will filter the range to what I want it be and create a new workbook. But how do I get it to then copy and paste the filtered range to the newly created workbook?

Sub BLC_JobNumber_Report_Test()

    Dim foundCell As Range
    Dim firstAddress As String
    Dim searchRng As Range
    Dim thisWb As Workbook
    Dim selJobNr As String
    Dim selClient As String
    Dim selProj As String
    Dim NameBase As String
    
    selJobNr = ActiveSheet.Cells(ActiveCell.Row, "B").Value
    selClient = ActiveSheet.Cells(ActiveCell.Row, "C").Value
    selProj = ActiveSheet.Cells(ActiveCell.Row, "D").Value
    NameBase = Format(Date, "mm.dd.yyyy")
    
    userAnswer = MsgBox("Run missing material report for job number " & selJobNr & "?", vbQuestion + vbYesNo, "User Repsonse")
    
    If userAnswer = vbYes Then
        
   With Sheet2.ListObjects("Open")
      .Range.AutoFilter 1, selJobNr
      
 ' What do I need to add here to get the filtered data above to copy and paste into the new workbook created below?

    End With
    End If
    
    
        Set thisWb = ActiveWorkbook
    Workbooks.Add
    ActiveWorkbook.SaveAs Filename:=thisWb.Path & "\Reports\" & selJobNr & " " & selClient & " " & selProj & "- " & NameBase & ".xlsx"
    
    
End Sub

 

[Falko26]

Alright I was able to figure it out after some trial and error. Here is some of the code to represent the copy paste stage and un filtering stage. The basic idea is you auto filter your data based on a criteria then simply copy only visible cells (.Range.SpecialCells(xlCellTypeVisible).Copy). Then paste as desired into new a workbook or sheet. I pasted column widths first then all data associated with cell. From here you jump back to your original workbook and un filter the selected range.

Sub BLC_JobNumber_Report()

    Dim foundCell As Range
    Dim firstAddress As String
    Dim searchRng As Range
    Dim thisWb As Workbook
    Dim selJobNr As String
    Dim selClient As String
    Dim selProj As String
    Dim NameBase As String
    
    selJobNr = ActiveSheet.Cells(ActiveCell.Row, "B").Value
    selClient = ActiveSheet.Cells(ActiveCell.Row, "C").Value
    selProj = ActiveSheet.Cells(ActiveCell.Row, "D").Value
    NameBase = Format(Date, "mm.dd.yyyy")
    
    userAnswer = MsgBox("Run missing material report for job number " & selJobNr & "?", vbQuestion + vbYesNo, "User Repsonse")

    If userAnswer = vbYes Then
    
     With Sheet2.ListObjects("Open")
      .Range.AutoFilter 1, selJobNr
      .Range.SpecialCells(xlCellTypeVisible).Copy
      
    End With
    
        Set thisWb = ActiveWorkbook
     Set WB_New = Workbooks.Add
     Range("A1").PasteSpecial Paste:=xlPasteColumnWidths
     Range("A1").PasteSpecial Paste:=xlPasteAll
     Range("A1").Select

         ThisWorkbook.Activate
         Sheets("Open").Select
    Range("Open[[#Headers],[Job Number:]]").Select
    ActiveSheet.ShowAllData

 

[Nena99]

Where is the end of your code?

 

[Falko26]

Hey Nena,

Here is the full code. Note that Its quite personalized for specific variables and folders.

Sub BLC_JobNumber_Report()

    Dim foundCell As Range
    Dim firstAddress As String
    Dim searchRng As Range
    Dim thisWb As Workbook
    Dim selJobNr As String
    Dim selClient As String
    Dim selProj As String
    Dim NameBase As String
    
    JobNr = ActiveSheet.Cells(ActiveCell.Row, "B").Value
    selJobNr = ActiveSheet.Cells(ActiveCell.Row, "B").Value
    selClient = ActiveSheet.Cells(ActiveCell.Row, "C").Value
    selProj = ActiveSheet.Cells(ActiveCell.Row, "D").Value
    NameBase = Format(Date, "mm.dd.yyyy")
    
    If IsEmpty(JobNr) Then
    MsgBox ("Please select a valid Job Number.")
    Exit Sub
    End If
    
    userAnswer = MsgBox("Run missing material report for job number " & selJobNr & "?", vbQuestion + vbYesNo, "User Repsonse")

    If userAnswer = vbYes Then
    
     With Sheet2.ListObjects("Open")
      .Range.AutoFilter 1, selJobNr
      .Range.SpecialCells(xlCellTypeVisible).Copy
      
    End With
    
        Set thisWb = ActiveWorkbook
     Set WB_New = Workbooks.Add
     Range("A1").PasteSpecial Paste:=xlPasteColumnWidths
     Range("A1").PasteSpecial Paste:=xlPasteAll
     Range("A1").Select
    
    
     ' Formatting New Workbook
    
        ' Add any code here to Format the data as you please
        
     ' Completed Formatting
    
  
     ActiveWorkbook.SaveAs Filename:=thisWb.Path & "\Reports\" & selJobNr & " " & selClient & " " & selProj & "- " & NameBase & ".xlsx", AccessMode:=xlExclusive, ConflictResolution:=Excel.XlSaveConflictResolution.xlLocalSessionChanges

         ThisWorkbook.Activate
         Sheets("Open").Select
    Range("Open[[#Headers],[Job Number:]]").Select
    ActiveSheet.ShowAllData
    
    WB_New.Activate
 
      MsgBox "Material report for job number " & selJobNr & " has ran successfully. File saved in 'Reports' folder."
      
    End If
        
End Sub

 

[Nena99]

Thank you, I know. I am trying to figure out how to fix my own problem.