Consulting

Results 1 to 10 of 10

Thread: Trying to code this VBA macro but it's beyond my knowledge

  1. #1
    VBAX Newbie
    Joined
    Jul 2019
    Posts
    5
    Location

    Question Trying to code this VBA macro but it's beyond my knowledge

    I've been given a set of instructions to manipulate weekly spreadsheets we receive from our tax fraud department and it would be really beneficial to set up a VBA macro as there are quite a few steps:


    I've had a stab at it myself but it's well beyond me - I've given the steps below plus my attempts at each step if applicable

    INPUT DATE
    RUN DIALOGUE : ENTER DATE (IN DD/MM/YYYY FORMAT)
    ??

    DATA MANIP

    IF A CELL IN COLUMN K IS NOT BLANK, MOVE THE CELLS (OF THAT ROW) HIJK TO GHIJ


    this is incorrect
        IF(NOTBLANK(K), 
        Range("H:K").Select
        Range("H:K").Cut Destination:=Range("G:J"), )

    DELETE COLUMN A (UPRN)
        Columns("A:A").Select
        Selection.Delete Shift:=xlToLeft



    DELETE COLUMNS NEWLY D & E & F (UNUSED ADDRESS FIELDS)
        Columns("D:F").Select
        Selection.Delete Shift:=xlToLeft

    REPLACE "." WITH "/" IN NEW COLUMNS E AND F


    Columns("E:F").Select
        Selection.Replace What:=".", Replacement:="/", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False

    TRIM ALL CELLS ... =TRIM






    CHECK THE LAST 4 CHARACTERS OF ALL CELLS IN COLUMN E AND DELETE THAT RESPECTIVE ROW IF THE LAST FOUR CHARACTERS DO NOT EQUAL "2099" ... =RIGHT(F1, 4)






    REMOVE LAST 5 CHARACTERS FROM ALL CELLS IN COLUMN F ... =LEFT(F1,






    DELETE ANY ROWS IF THE DATE IN COLUMN F IS LESS THAN OR EQUAL TO THE DATE GIVEN IN STEP 1
    ??





    DELETE COLUMNS E AND F

        Columns("E:F").Select
        Selection.Delete Shift:=xlToLeft

    FORMATTING


    EXPAND ALL
        Cells.Select
        Cells.EntireColumn.AutoFit



    SELECT ALL CELLS THAT CONTAIN DATA AND CREATE BORDER



    TYPE IN CELL READY TO PRINT


        Columns("F:F").Select
        Selection.ColumnWidth = 14
        Range("F1").Select
        ActiveCell.FormulaR1C1 = "READY TO PRINT!"

  2. #2
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    Doable, but a small representive sanitized sample workbook would make it easier

    Attach it using the instructuins in my sig
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  3. #3
    VBAX Newbie
    Joined
    Jul 2019
    Posts
    5
    Location
    Quote Originally Posted by Paul_Hossler View Post
    Doable, but a small representive sanitized sample workbook would make it easier

    Attach it using the instructuins in my sig
    Thanks, attached a sample
    Attached Files Attached Files

  4. #4
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    Q: Do they give you the CSV file or an XLSX?

    Q: Do you want to give them back an XLSX?

    Q: Do you want a 'master' XLSM with the macro and just process the input data?



    I'm assuming, Yes, Yes, and Yes.

    The macro in WB#1 would open the CSV into another WB#2

    Format WB#2

    Save WB#2 as an XLSX
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  5. #5
    VBAX Newbie
    Joined
    Jul 2019
    Posts
    5
    Location
    Quote Originally Posted by Paul_Hossler View Post
    Q: Do they give you the CSV file or an XLSX?

    Q: Do you want to give them back an XLSX?

    Q: Do you want a 'master' XLSM with the macro and just process the input data?
    The file comes to us as a .CSV, and ideally I'd like to open this in excel and run the macro and save as an XLSX

  6. #6
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    OK, look at this version

    The 'dates' were a little tricky since they were not Excel-real dates, just strings that sort of looked like dates

    I thought it was best to make them real dates, and format based on the Windows Regional Settings (US, UK, etc.) - screen shot in attachment Reformat.xlsm

    I didn't know what Col A was to format it better

    Anyway, I think I understood what you wanted to do, even if I changed the way you wanted to do it


    Option Explicit
    
    Const cModule As String = "Reformat File"
    
    Sub ReformatFile()
        Dim dtCutoff As Date
        
        Dim csvPath As String, csvXLSX As String
        Dim csvWorkbook As Workbook
        Dim csvWorksheet As Worksheet
        
        Dim i As Long, rowData As Long, colData As Long
        Dim rData As Range
        
        
        'get CSV filename, exit if canceled
        csvPath = Application.GetOpenFilename("CSV File, *.csv")
        If csvPath = "False" Then Exit Sub
    
        'INPUT DATE - uses regional settings for date format
        dtCutoff = Application.InputBox("Enter Cut Off Date, blank to Exit", "Cut Off Date", 0, , , , , 2)
        If CLng(dtCutoff) = 0 Then Exit Sub
        
        Application.ScreenUpdating = False
    
    
        'make XLSX file name
        i = InStrRev(csvPath, ".")
        csvXLSX = Left(csvPath, i) & "xlsx"
    
    
        'open CSV into new WB
        Workbooks.Open Filename:=csvPath
        Set csvWorkbook = ActiveWorkbook
        Set csvWorksheet = ActiveSheet
        
        Set rData = csvWorksheet.Cells(1, 1).CurrentRegion
        With rData
            .EntireColumn.AutoFit
            'IF A CELL IN COLUMN K IS NOT BLANK, MOVE THE CELLS (OF THAT ROW) HIJK TO GHIJ
            For rowData = 1 To .Rows.Count
                If Len(.Cells(rowData, 11).Value) > 0 Then
                    For colData = 7 To 10
                        .Cells(rowData, colData).Value = .Cells(rowData, colData + 1).Value
                    Next colData
                    .Cells(rowData, 11).ClearContents
                End If
            Next rowData
    
    
            'DELETE COLUMN A (UPRN)
            .Columns(1).Delete
    
            'DELETE COLUMNS NEWLY D & E & F (UNUSED ADDRESS FIELDS)
            .Columns(6).Delete
            .Columns(5).Delete
            .Columns(4).Delete
    
            'CHECK THE LAST 4 CHARACTERS OF ALL CELLS IN COLUMN E AND DELETE THAT RESPECTIVE ROW IF THE LAST FOUR CHARACTERS DO NOT EQUAL "2099"
            For rowData = .Rows.Count To 1 Step -1  '   bottom's up
                If Right(.Cells(rowData, 5).Value, 4) <> "2099" Then .Rows(rowData).EntireRow.Delete
            Next rowData
            
            'ADDED - make text into real dates, region settings independent
            For rowData = 1 To .Rows.Count
                'DD.MM.YYYY
                '01.05.2019
                .Cells(rowData, 4).Value = DateSerial(Right(.Cells(rowData, 4).Value, 4), Mid(.Cells(rowData, 4).Value, 4, 2), Left(.Cells(rowData, 4).Value, 2))
                .Cells(rowData, 5).Value = DateSerial(Right(.Cells(rowData, 5).Value, 4), Mid(.Cells(rowData, 5).Value, 4, 2), Left(.Cells(rowData, 5).Value, 2))
                
                'DD.MM.YYYY
                '04.07.2019 14:18:50
                .Cells(rowData, 6).Value = DateSerial(Mid(.Cells(rowData, 6).Value, 7, 4), Mid(.Cells(rowData, 6).Value, 4, 2), Left(.Cells(rowData, 6).Value, 2))
            Next rowData
            
            'DELETE ANY ROWS IF THE DATE IN COLUMN F IS LESS THAN OR EQUAL TO THE DATE GIVEN IN STEP 1
            For rowData = .Rows.Count To 1 Step -1 '   bottom's up
                If .Cells(rowData, 6).Value <= dtCutoff Then .Rows(rowData).EntireRow.Delete
            Next rowData
            
            'ADDED - should use regional settings
            .Columns(6).NumberFormat = "m/d/yyyy"
            .Columns(5).NumberFormat = "m/d/yyyy"
            .Columns(4).NumberFormat = "m/d/yyyy"
    
        End With
        
        'delete xlsx if exists
        Application.DisplayAlerts = False
        On Error Resume Next
        Kill csvXLSX
        On Error GoTo 0
        Application.DisplayAlerts = True
        csvWorkbook.SaveAs Filename:=csvXLSX, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
        csvWorkbook.Close
        
        ThisWorkbook.Activate
        Application.ScreenUpdating = True
        
        Call MsgBox("File saved as " & vbCrLf & vbCrLf & csvXLSX, vbInformation + vbOKOnly, cModule)
    End Sub
    
    Attached Files Attached Files
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  7. #7
    VBAX Newbie
    Joined
    Jul 2019
    Posts
    5
    Location
    Quote Originally Posted by Paul_Hossler View Post
    OK, look at this version

    ..
    Wow Paul thank you so much ! This will save countless hours in the future for my team as well as our neighbouring authorities -

    Just for formatting purposes, column B and C (post-macro) for some reason contain a lot of blank spaces after the data - how would I go about 'trimming' this unwanted space off the end?

    I've played around with the cut-off date and using DD/MM/YYYY (I tried using 26/06/2019 (and it's still seemed to pull through prior dates)

    Also once they have served their purpose I could delete columns E & F after the rest of the code, I assume I just use

    .Columns(5).Delete
    .Columns(6).Delete
    From there I'll format it which I can add at the end of the code - my only query regarding this is - how would I go about adding borders around the text equal to the # of rows remaining on the spreadsheet? In the past I've just used a
     Range("A1:D50").Select
    when the reports have always contained the same # of rows, but in this case, it can vary significantly
    Last edited by Jakers; 07-19-2019 at 03:09 AM.

  8. #8
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    1. Just for formatting purposes, column B and C (post-macro) for some reason contain a lot of blank spaces after the data - how would I go about 'trimming' this unwanted space off the end?


    2. I've played around with the cut-off date and using DD/MM/YYYY (I tried using 26/06/2019 (and it's still seemed to pull through prior dates)


    3. Also once they have served their purpose I could delete columns E & F after the rest of the code, I assume I just use

    4. From there I'll format it which I can add at the end of the code - my only query regarding this is - how would I go about adding borders around the text equal to the # of rows remaining on the spreadsheet?


    1. See the .Trim

    2. I put PC in UK date format mode so today = "19/07/2019" -- I don't see any Col F dates prior to 26/6/2019

    "DELETE ANY ROWS IF THE DATE IN COLUMN F IS LESS THAN OR EQUAL TO THE DATE GIVEN IN STEP 1"


    Capture.JPG


    3. Deleted E and F

    4. Bordered
    Attached Files Attached Files
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  9. #9
    VBAX Newbie
    Joined
    Jul 2019
    Posts
    5
    Location
    Quote Originally Posted by Paul_Hossler View Post
    [/LEFT]

    1. See the .Trim

    2. I put PC in UK date format mode so today = "19/07/2019" -- I don't see any Col F dates prior to 26/6/2019

    "DELETE ANY ROWS IF THE DATE IN COLUMN F IS LESS THAN OR EQUAL TO THE DATE GIVEN IN STEP 1"


    Capture.JPG


    3. Deleted E and F

    4. Bordered


    Thank you Paul, seriously - you're an absolute godsend..!

  10. #10
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    <BLUSH>

    Mark it SOLVED if you're done -- #3 in my sig
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •