Modify existing code to filter export data off a list

ItalianPlatinum

Well-known Member
Joined
Mar 23, 2017
Messages
880
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
Hello - Looking for help to modify my code to be able to define a list I choose to drive what the final export file will be. My current code in layman's terms opens an external file, formats it, inserts it into the workbook where the code is, then copies it over to another tab as the defined format it should be in then finally export that sheet to csv.

The variable I am looking for is to be able to input in a range in like column W to only see those types. in my workbook the first part exists. in the external file it only has the unique tag. the data set is huge so i tried to reduce it to simple terms below. i include my orginal code if it helps:

Book2
ABCDEFGHIJKLMNOPQRSTUVW
1TypeNameCategorySubmissionsUnique TagIGNOREIGNOREPriceIGNOREIGNOREIGNOREIGNOREIGNOREIGNOREIGNOREIGNOREIGNOREIGNOREIGNORESKU
2AA1ABC110XXXXXX
3AA2BBB120VVVVV
4AA3CCC110.5WWWWW
5AA4DDD122AAAAA
6BB1ACD123PPPPP
7BB2ADD145RRRSSS
8BB3AFF195TYTYT
9BB4AGG178LLLLL
10CC1LLL145UUUUU
11CC2LLL265MMMMM
12CC3LLL337BBBBB
13CC4YYY419DDDDDDFor Export
14DD2UUU882EEEEEEAA
15DD3PPP034QQQQQCC
16DD4MNM182SSSSSSEE
17EE1AFD171BBBBBB
18EE2DF2117RRSARA
19
20Upload Final file Example
21ABCDEFGHIJKLMNOPQRSTUV
22XXABC1XX10XX10XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
23XXBBB1XX20XX20XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXVVVVV
24XXCCC1XX10.5XX10.5XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXWWWWW
25XXDDD1XX22XX22XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXAAAAA
26XXACD1XX23XX23XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXPPPPP
27XXADD1XX45XX45XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXRRRSSS
28XXAFF1XX95XX95XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXTYTYT
29XXAGG1XX78XX78XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXLLLLL
30XXLLL1XX45XX45XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXUUUUU
31XXLLL2XX65XX65XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXMMMMM
32XXLLL3XX37XX37XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXBBBBB
33XXYYY4XX19XX19XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXDDDDDD
34XXUUU8XX82XX82XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXEEEEEE
35XXPPP0XX34XX34XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXQQQQQ
36XXMNM1XX82XX82XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXSSSSSS
37XXAFD1XX71XX71XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXBBBBBB
38XXDF21XX17XX17XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXRRSARA
Compare

VBA Code:
Option Explicit
Sub CN()
    Dim sPath As String, sPartial As String, sFName As String
    Dim rws As Long
    
Application.ScreenUpdating = False
  
'Clear CV Sheet
With Sheets("CV")
    .Cells.ClearContents
End With
  
'Clear CN Upload Sheet
With Sheets("CN")
   .Range("A2:V" & rows.count).ClearContents
End With
  
    sPath = "XXX"      ' <<<<< change accordingly
  
    sPartial = "ZZZ" & Year(Now) & IIf(Len(Month(Now)) = 1, "0" & Month(Now), Month(Now)) & IIf(Len(Day(Now)) = 1, "0" & Day(Now), Day(Now)) & "*.csv"
    sFName = Dir(sPath & sPartial)
    If Len(sFName) > 0 Then
        Workbooks.OpenText sPath & sFName
    
With Sheets("ZZZ")
   .Range("A:Z").Copy
End With

Workbooks("NC").Sheets("CV").Range("A1").PasteSpecial
Workbooks("NC").Sheets("CV").Columns("A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

CommaDelimited2

Workbooks(sFName).Close SaveChanges:=False
CN_2

Application.ScreenUpdating = True

    Else
        MsgBox "File not found.", vbExclamation
    End If

Workbooks("NC").Sheets("COMPARE").Activate

End Sub
Sub CommaDelimited2()
    Columns("A:A").Select
    Application.CutCopyMode = False
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(3, 1), Array(20, 1), Array(26, 1), Array(27, 1), _
        Array(40, 1), Array(41, 1), Array(54, 1), Array(55, 1), Array(62, 1), Array(76, 1), Array( _
        90, 1), Array(103, 1), Array(113, 1), Array(125, 1), Array(136, 1), Array(149, 1), Array( _
        152, 1)), TrailingMinusNumbers:=True
End Sub

Sub CN_2()
    Dim Sheet As Worksheet
    Dim FoundRange As Range
    Dim LastRow As Long
    Dim rws As Long
    
With Workbooks("NC").Sheets("CV")
  rws = .Range("B2:B2").End(xlDown).row - 1
  Workbooks("NC").Sheets("CN").Range("B2").Resize(rws, 1).Value = .Range("B2").Resize(rws).Value
End With
    
With Workbooks("NC").Sheets("CV")
  rws = .Range("E2:E2").End(xlDown).row - 1
  Workbooks("NC").Sheets("CN").Range("F2").Resize(rws, 1).Value = .Range("E2").Resize(rws).Value
End With
        
With Workbooks("NC").Sheets("CV")
  rws = .Range("G2:G2").End(xlDown).row - 1
  Workbooks("NC").Sheets("CN").Range("H2").Resize(rws, 1).Value = .Range("G2").Resize(rws).Value
End With
        
With Workbooks("NC").Sheets("CV")
  rws = .Range("R2:R2").End(xlDown).row - 1
  Workbooks("NC").Sheets("CN").Range("V2").Resize(rws, 1).Value = .Range("R2").Resize(rws).Value
End With
        
        Set Sheet = Worksheets("CN")
        LastRow = Sheet.Cells(Sheet.rows.count, 2).End(xlUp).row
        If LastRow < 2 Then Exit Sub
        
        On Error Resume Next
        Set FoundRange = Sheet.Range("B2:B" & LastRow).SpecialCells(xlCellTypeConstants)
        On Error GoTo 0
        If FoundRange Is Nothing Then Exit Sub
        
        UpdateColumnValues FoundRange, "A", "MU", LastRow, 2, Sheet, True
        UpdateColumnValues FoundRange, "C", "F", LastRow, 2, Sheet, True
        UpdateColumnValues FoundRange, "D", "F", LastRow, 2, Sheet, True
        UpdateColumnValues FoundRange, "E", "R", LastRow, 2, Sheet, True
        UpdateColumnValues FoundRange, "J", "NA", LastRow, 2, Sheet, True
        UpdateColumnValues FoundRange, "M", "NA", LastRow, 2, Sheet, True
        UpdateColumnValues FoundRange, "N", "#", LastRow, 2, Sheet, True
        UpdateColumnValues FoundRange, "T", Format(Now, "MM/DD/YY"), LastRow, 2, Sheet, True
        UpdateColumnValues FoundRange, "U", "US", LastRow, 2, Sheet, True
              
Sheets("CN").Copy
GetNameAndSaveAsCSV2

End Sub
Sub GetNameAndSaveAsCSV2()

    Dim oWb         As Workbook
    Dim sMyFile     As String
    Dim sSavedFile  As String

    sMyFile = "AAA" & "BBB" & Format(Now, "MMDDYY") & ".csv"  ' <<< change as required
  
    Set oWb = ActiveWorkbook                                    ' <<< change as required

    ' return with drive:\folder\filename.ext  of saved file
    sSavedFile = FileSaveAs(oWb, sMyFile)

    Set oWb = Nothing
End Sub
 

Excel Facts

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.

Forum statistics

Threads
1,224,823
Messages
6,181,173
Members
453,021
Latest member
Justyna P

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
Back
Top