Extra rows in CSV after saving macro sheet

user_16588446 0
Viewed 43

I have a macro that formats some data. But for some reason it is saving extra rows with commas and is causing me issues. Is there something wrong with my macro causing this or how do I fix this? The data comes to me in an excel file. I paste it into my sheet with the macro, run it, then save as CSV.

Macro code:

    Option Explicit

Sub runClick()
    
    ' remove MRT rows
    Application.DisplayAlerts = False
    
    Dim rng As Range
    Dim LR As Long
    Dim LC As Long
    LR = Worksheets("WeeklyWelcomeEmailData").Cells(Rows.Count, 1).End(xlUp).Row
    LC = Worksheets("WeeklyWelcomeEmailData").Cells(1, Columns.Count).End(xlToLeft).Column
    
    Set rng = ThisWorkbook.Worksheets("WeeklyWelcomeEmailData").Range("A1:Z" & LR)
    
    rng.AutoFilter Field:=4, Criteria1:="MRT"
    rng.Offset(1, 0).SpecialCells(xlCellTypeVisible).Delete
    
    AutoFilterMode = False
    
    Application.DisplayAlerts = True
    
    ' find and replace Purpose column (S)
    Range("S:S").Replace What:="PURCHASE", Replacement:="Purchase", MatchCase:=False
    Range("S:S").Replace What:="RESELL", Replacement:="Resale", MatchCase:=False
    
    ' remove commas and extra spaces in Vendor column (F)
    Dim tVendor As String
    tVendor = "F1:F" & Cells(Rows.Count, "F").End(xlUp).Row
    Range(tVendor) = Evaluate("IF(" & Range(tVendor).Address(0, 0) & "="""","""",Trim(SUBSTITUTE(" & Range(tVendor).Address(0, 0) & ","","","" "")))")
    
    ' format to short date
    'H
    Dim tShortDate1 As String
    tShortDate1 = "H1:H" & Cells(Rows.Count, "H").End(xlUp).Row
    Range(tShortDate1).NumberFormat = "m/d/yyyy"
    'T
    Dim tShortDate2 As String
    tShortDate2 = "T1:T" & Cells(Rows.Count, "T").End(xlUp).Row
    Range(tShortDate2).NumberFormat = "m/d/yyyy"
    'X
    Dim tShortDate3 As String
    tShortDate3 = "X1:X" & Cells(Rows.Count, "X").End(xlUp).Row
    Range(tShortDate3).NumberFormat = "m/d/yyyy"
    'Y
    Dim tShortDate4 As String
    tShortDate4 = "Y1:Y" & Cells(Rows.Count, "Y").End(xlUp).Row
    Range(tShortDate4).NumberFormat = "m/d/yyyy"

End Sub

Output after saving

Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data
Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data
Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data
Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data
Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data
Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data
Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data
Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data,Data
,,,,,,,,,,,,,,,,,,,,,,,,,,,
,,,,,,,,,,,,,,,,,,,,,,,,,,,
,,,,,,,,,,,,,,,,,,,,,,,,,,,
,,,,,,,,,,,,,,,,,,,,,,,,,,,
,,,,,,,,,,,,,,,,,,,,,,,,,,,
,,,,,,,,,,,,,,,,,,,,,,,,,,,
,,,,,,,,,,,,,,,,,,,,,,,,,,,
,,,,,,,,,,,,,,,,,,,,,,,,,,,
,,,,,,,,,,,,,,,,,,,,,,,,,,,
,,,,,,,,,,,,,,,,,,,,,,,,,,,
,,,,,,,,,,,,,,,,,,,,,,,,,,,
vba excel
1 Answers

'Clean' Imported Data

Option Explicit

Sub runClick()
    
    Const FilterField As Long = 4
    Const FilterCriteria1 As String = "MRT"
    Const sdColumns As String = "H:H,T:T,X:X,Y:Y"
    Const sdFormat As String = "m/d/yyyy" ' possibly "m\/d\/yyyy"
    
    Dim wb As Workbook: Set wb = ThisWorkbook
    
    Dim ws As Worksheet: Set ws = wb.Worksheets("WeeklyWelcomeEmailData")
    If ws.AutoFilterMode Then
        ws.AutoFilterMode = False
    End If
    
    ' Create a reference to the Table Range (headers included).
    Dim trg As Range: Set trg = ws.Range("A1").CurrentRegion
    
    ' Validate.
    Dim trCount As Long: trCount = trg.Rows.Count
    If trCount = 1 Then Exit Sub ' one row only (no data)
    Dim tcCount As Long: tcCount = trg.Columns.Count
    If tcCount < FilterField Then Exit Sub ' too few columns
    
    ' Create a reference to the Data Range (without headers).
    Dim drg As Range: Set drg = trg.Resize(trCount - 1).Offset(1)
    'Debug.Print trg.Address, drg.Address
    
    ' Delete criteria rows.
    trg.AutoFilter Field:=FilterField, Criteria1:=FilterCriteria1
    If Application.Subtotal(103, trg.Columns(FilterField)) > 1 Then
        ' Create a reference to the SpecialCells Range.
        Dim scrg As Range: Set scrg = drg.SpecialCells(xlCellTypeVisible)
        'Debug.Print scrg.Address
        ' Note that by first turning off the AutoFilterMode and only
        ' then deleting, the cells to the right of the Table Range
        ' are not affected. (The cells to the bottom are shifted up.)
        ws.AutoFilterMode = False
        scrg.Delete
    Else
        ws.AutoFilterMode = False
    End If
    
    ' Validate.
    If drg Is Nothing Then Exit Sub ' all data rows did contain the criteria
    'Debug.Print trg.Address, drg.Address
    
    Dim cCol As Long
    
    ' find and replace Purpose column (S)
    cCol = 19 ' S
    If tcCount >= cCol Then
        drg.Columns(cCol).Replace "PURCHASE", "Purchase", xlWhole, , False
        drg.Columns(cCol).Replace "RESELL", "Resale", xlWhole, , False
    End If
    
    ' remove commas and extra spaces in Vendor column (F)
    cCol = 6 ' F
    If tcCount >= cCol Then
        With drg.Columns(cCol)
            .Value = Evaluate("IF(" & .Address(0, 0) _
                & "="""","""",Trim(SUBSTITUTE(" & .Address(0, 0) _
                & ","","","" "")))")
        End With
    End If
    
    ' format to short date in columns (H,T,X,Y)
    cCol = 25 ' Y
    If tcCount >= cCol Then
        Intersect(drg, ws.Range(sdColumns)).NumberFormat = sdFormat
    End If

    'wb.Save

End Sub
user_98140690
Related