csv generation help

Jake975

Board Regular
Joined
Feb 9, 2020
Messages
101
Office Version
  1. 2016
Platform
  1. Windows
I have a macro that creates a csv file of a list of files to be put into pdfsam my issue is i need to adapt it to create another file as well for a different packet. I have attached the module for the code that dose that part of the process.
This time i need it to looks a column "Packet B" and only create a csv file with the numbers from that column.
Also number 3 I need to be a dynamic spot meaning the file could be like the sample name or like "RM###"
VBA Code:
Public Sub Temp_clear()
With NightAuditP
.Action.Caption = "Cleaning up Temp files"
End With

Range("A1").EntireRow.Delete
Range("B1").EntireColumn.Delete
End Sub
Public Sub Temp_delete_sheet()
With NightAuditP
.Action.Caption = "Cleaning up Temp files final stages"
End With

Application.DisplayAlerts = False
Sheets("Temp").Delete
Application.DisplayAlerts = True
With NightAuditP
.Action.Caption = "Temp files completed sucessfully"
End With
End Sub
Public Sub ListAllFileedit()

    Dim objFSO As Object
    Dim objFolder As Object
    Dim objFile As Object
    Dim ws As Worksheet
    Dim sPath As String
    Dim lrA As Long
    Dim lrB As Long
With NightAuditP
.Action.Caption = "Creating Temp files"
End With
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set ws = Worksheets.Add
    ActiveSheet.name = "Temp"
    Sheets("Home").Activate
    'Get the folder object associated with the directory
    sPath = ActiveSheet.Range("H1")
    Set objFolder = objFSO.GetFolder(sPath)
    Sheets("Temp").Activate
    ws.Cells(1, 1).Value = "Location"
    ws.Cells(1, 2).Value = "Final Order#"
    'ws.Cells(1, 3).Value = "The file Size is:"

    'Loop through the Files collection
    For Each objFile In objFolder.Files
    'If objFile.Name Like "*.pdf" Then
        lrA = Range("A" & Rows.Count).End(xlUp).Row
        'lrB = Range("B" & Rows.Count).End(xlUp).Row
        ws.Range("A" & lrA + 1).Value = objFile.path
        'ws.Range("B" & lrB + 1).Value = objFile.DateLastModified
        'ws.Range("C" & lrB + 1).Value = objFile.Size
    'End If
    Next
Call TempSort
Call Temp_clear
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets("Temp").Copy
ActiveWorkbook.SaveAs Filename:=objFolder & "\" & "Temp.csv", FileFormat:=xlCSV
ActiveWorkbook.Close True
Call Temp_delete_sheet

End Sub
Public Sub Save_temp(ByRef argUSF As Object, ByVal argSteps As Integer)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets("Temp").Copy
ActiveWorkbook.SaveAs Filename:=objFolder & "\" & "Temp.csv", FileFormat:=xlCSV
ActiveWorkbook.Close True
End Sub
Public Sub TempSort()
    Application.ScreenUpdating = False
    Dim rng As Range, WS1 As Worksheet, WS2 As Worksheet, desWS As Worksheet, fnd As Range
    Set WS1 = Sheets("Temp")
    Set WS2 = Sheets("Data List")
With NightAuditP
.Action.Caption = "Sorting Temp files"
End With

     With ActiveWorkbook.Worksheets("Temp").Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("A1") _
            , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
        .SetRange .Parent.UsedRange
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    For Each rng In WS2.Range("C2", WS2.Range("C" & WS2.Rows.Count).End(xlUp))
        Set fnd = WS1.Range("A:A").Find(rng, LookIn:=xlValues, lookat:=xlPart)
        If Not fnd Is Nothing Then
            fnd.Offset(, 1) = rng.Offset(, 1)
        End If
    Next rng
    Application.ScreenUpdating = True
    
     With ActiveWorkbook.Worksheets("Temp").Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("B1") _
            , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange .Parent.UsedRange
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
With NightAuditP
.Action.Caption = "Sorting Temp files completed"
End With

End Sub
Any help would be great thank you for your time
 

Some videos you may like

Excel Facts

Workdays for a market open Mon, Wed, Friday?
Yes! Use "0101011" for the weekend argument in NETWORKDAYS.INTL or WORKDAY.INTL. The 7 digits start on Monday. 1 means it is a weekend.

Jake975

Board Regular
Joined
Feb 9, 2020
Messages
101
Office Version
  1. 2016
Platform
  1. Windows
After looking at it more It is this part i know needs adjusted
VBA Code:
 For Each rng In WS2.Range("C2", WS2.Range("C" & WS2.Rows.Count).End(xlUp))
        Set fnd = WS1.Range("A:A").Find(rng, LookIn:=xlValues, lookat:=xlPart)
        If Not fnd Is Nothing Then
            fnd.Offset(, 1) = rng.Offset(, 1)
        End If
That is the part that is returning the number for sorting in the desired order
 

Jake975

Board Regular
Joined
Feb 9, 2020
Messages
101
Office Version
  1. 2016
Platform
  1. Windows
I need to change the rng.offset to 3
 

Jake975

Board Regular
Joined
Feb 9, 2020
Messages
101
Office Version
  1. 2016
Platform
  1. Windows
Here is the data sheet
1610158888447.png
 

Watch MrExcel Video

Forum statistics

Threads
1,127,612
Messages
5,625,846
Members
416,138
Latest member
Pizzaman22

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top