Macro for array vlookup to worksheet [Solved/Closed]

Michael - Apr 14, 2010 at 10:02 PM - Latest reply: rizvisa1 4481 Posts Thursday January 28, 2010Registration dateContributorStatus January 6, 2016 Last seen
- May 6, 2010 at 12:14 PM
Looking for help with a quick macro please.


I have four tabs in the workbook:
Datadump - contains daily raw data to clean
Central - Accounts for central district
West - Accounts for West district
East - Accounts for East district
Accounts - 3 column array of accounts for each district

Would like the macro to look at the accounts on the Accounts tab and compare them to a column on the Datadump tab and if a match is found copy it to the coresponding tab for that district?

I have a VLOOKUP forumala that tells me which row in the datadump goes where but I have had problems trying to find where to start with a macro.

Any help or suggestions would be great!
See more 

14 replies

Best answer
rizvisa1 4481 Posts Thursday January 28, 2010Registration dateContributorStatus January 6, 2016 Last seen - Apr 15, 2010 at 09:12 AM
2
Thank you
Try this

Sub MoveData()

Dim DatadumpSheet As String 'name of data dump sheet
Dim AccountSheet As String 'name of account sheet

Dim lMaxRows As Long 'max number of rows
Dim iTempCol As Integer ' index of a temp column to assist in calc
Dim Sheet As Object 'an object variable to be used for looping of sheet
Dim sAccountName As String 'account number

    'sheet names
    DatadumpSheet = "Datadump"
    AccountSheet = "Accounts"
    
    Sheets(DatadumpSheet).Select
     
    'make sure that data is unfiltered in order to get to right count of max used rows
    Cells.Select
    If ActiveSheet.AutoFilterMode Then
     
        On Error Resume Next
         
        ActiveSheet.ShowAllData
         
        On Error GoTo 0
     
    End If
     
    'max used rows in column A, with presumption that this column would always have most rows
    lMaxRows = Cells(Rows.Count, "A").End(xlUp).Row
    
    'max used column on row 1 and adding one to it to get location of our temp col
    iTempCol = Cells(1, Columns.Count).End(xlToLeft).Column + 1
     
    'column header for temp col
    Cells(1, iTempCol) = "Move Where"
     
    'applying vlookup in temp column to find out region of account east/central etc
    With Range(Cells(2, iTempCol), Cells(lMaxRows, iTempCol))
     
        .FormulaR1C1 = "=VLOOKUP(RC3, '" & AccountSheet & "'!C1:C2,2,FALSE)"
         
    End With
     
     
    'looping thru all the sheets, to get the sheet name
    ' and then using that sheet name (EAST /CENTRAL etc) to apply filter on datadump
    For Each Sheet In Sheets
         
        'finding the sheet name and presuming that this is the account region that needs to be seeked
        sAccountName = Sheet.Name
     
        Sheets(DatadumpSheet).Select
        Cells.Select
        
        'if filter  not present, then apply one
        If ActiveSheet.AutoFilterMode = False Then
            Selection.AutoFilter
        End If
        
         
        'apply filter on our temp column of the sheet being checked (east. centeral etc)
        Selection.AutoFilter Field:=iTempCol, Criteria1:="=" & sAccountName, Operator:=xlAnd, Criteria2:="<>"
         
        'finding out max row number that is visible
        lMaxRows = Cells(Rows.Count, iTempCol).End(xlUp).Row
                 
        '>1 indicate that there are some rows where the account region match the sheet name
        If lMaxRows > 1 Then
            ' in case you want heads to be pasted too
            Range(Cells(1, 1), Cells(lMaxRows, iTempCol - 1)).Copy
         
            ' in case you dont want the headers to be pasted
            ' Range(Cells(2, 1), Cells(lMaxRows, iTempCol - 1)).Copy
         
            Sheets(sAccountName).Range("A1").PasteSpecial
        End If
         
    Next Sheet
     
    'clear temp column
    Range(Cells(2, iTempCol), Cells(lMaxRows, iTempCol)).Clear
    
    Cells.Select
    If ActiveSheet.AutoFilterMode Then
     
        On Error Resume Next
         
        ActiveSheet.ShowAllData
         
        On Error GoTo 0
     
    End If
     
    Range("A1").Select
     
End Sub

Thank you, rizvisa1 2

Something to say? Add comment

CCM has helped 1662 users this month

rizvisa1 4481 Posts Thursday January 28, 2010Registration dateContributorStatus January 6, 2016 Last seen - Apr 20, 2010 at 02:33 PM
1
Thank you
Assumptions:
1. Sheets "Datadump" and "Accounts" are present

2. Data from sheets where districts information (central/east/west etc) is copied can be delete

3. Data from districts information is to deleted when the data is older than 14:00:00 on day before today (date -1)

4. the final sheets has to be saved by postfixing todays data in mmddyyyy format
Code:

Sub MoveData()

Dim DatadumpSheet As String 'name of data dump sheet
Dim AccountSheet As String 'name of account sheet

Dim lMaxRows As Long 'max number of rows
Dim iTempCol As Integer ' index of a temp column to assist in calc
Dim Sheet As Object 'an object variable to be used for looping of sheet
Dim sAccountName As String 'account number

Dim iColDateRec As Integer ' column position for Date Received
Dim iColTimeRec As Integer ' column position for Time Received

Dim sCurrentDate As String ' to store current date in MMDDYYYY format
Dim sDateTimeFilter As String ' filter for date and time
Dim sFileName As String   ' file name

    'sheet names
    DatadumpSheet = "Datadump"
    AccountSheet = "Accounts"

    Sheets(DatadumpSheet).Select
    
    ' find the position of text "Data Received" on row 1
    iColDateRec = Application.WorksheetFunction.Match("Date Received", Range("1:1"), 0)
    
    ' find the position of text "Time Received" on row 1
    iColTimeRec = Application.WorksheetFunction.Match("Time Received", Range("1:1"), 0)
    
      'getting current date and formatting it to MMDDYYYY format
    sCurrentDate = Format(Date, "MMDDYYYY")
    
    ' getting filter one day before todays date   (date -1)
    sDateTimeFilter = Format(Date - 7 & " 14:00:00", "YYYY-MM-DD hh:mm:ss")
    
    sFileName = ActiveWorkbook.FullName
    sFileName = Left(sFileName, InStrRev(sFileName, ".") - 1) & "_" & sCurrentDate & Mid(sFileName, InStrRev(sFileName, "."))
    
    'make sure that data is unfiltered in order to get to right count of max used rows
    Cells.Select
    If ActiveSheet.AutoFilterMode Then
     
        On Error Resume Next
         
        ActiveSheet.ShowAllData
        ActiveSheet.AutoFilterMode = False
        On Error GoTo 0
     
    End If
     
    'max used rows in column A, with presumption that this column would always have most rows
    lMaxRows = Cells(Rows.Count, "A").End(xlUp).Row
    
    
    'max used column on row 1 and adding one to it to get location of our temp col
    iTempCol = Cells(1, Columns.Count).End(xlToLeft).Column + 1
     
    'column header for temp col
    Cells(1, iTempCol) = "Move Where"
     
    'applying vlookup in temp column to find out region of account east/central etc
    With Range(Cells(2, iTempCol), Cells(lMaxRows, iTempCol))
     
        .FormulaR1C1 = "=VLOOKUP(RC3, '" & AccountSheet & "'!C1:C2,2,FALSE)"
         
    End With
     
    'looping thru all the sheets, to get the sheet name
    ' and then using that sheet name (EAST /CENTRAL etc) to apply filter on datadump
    For Each Sheet In Sheets
         
        'finding the sheet name and presuming that this is the account region that needs to be seeked
        sAccountName = Sheet.Name
     
        Sheets(DatadumpSheet).Select
        Cells.Select
        
        'if filter  not present, then apply one
        If ActiveSheet.AutoFilterMode = False Then
            Selection.AutoFilter
        End If
        
        'apply filter on our temp column of the sheet being checked (east. centeral etc)
        Selection.AutoFilter Field:=iTempCol, Criteria1:="=" & sAccountName, Operator:=xlAnd, Criteria2:="<>"
        
        'finding out max row number that is visible
        lMaxRows = Cells(Rows.Count, iTempCol).End(xlUp).Row
                 
        '>1 indicate that there are some rows where the account region match the sheet name
        If lMaxRows > 1 Then
            ' in case you want heads to be pasted too
            Range(Cells(1, 1), Cells(lMaxRows, iTempCol - 1)).Copy
         
            ' in case you dont want the headers to be pasted
            ' Range(Cells(2, 1), Cells(lMaxRows, iTempCol - 1)).Copy
         
            Sheets(sAccountName).Range("A1").PasteSpecial
            Sheets(sAccountName).Select
            
            'sorting
            Selection.Sort _
                Key1:=Range(Cells(2, iColDateRec).Address), Order1:=xlAscending, _
                Key2:=Range(Cells(2, iColTimeRec).Address), Order2:=xlAscending, _
                Header:=xlYes, OrderCustom:=1, _
                MatchCase:=False, Orientation:=xlTopToBottom, _
                DataOption1:=xlSortNormal
            
    
            'applying FORMULA TO GET DATE AND TIME
            With Range(Cells(1, iTempCol), Cells(lMaxRows, iTempCol))
             
                .FormulaR1C1 = "=RC" & iColDateRec & " + RC" & iColTimeRec
                 .NumberFormat = "YYYY-MM-DD hh:mm:ss"
            End With
    
            'if filter  not present, then apply one
            Cells.Select
            If ActiveSheet.AutoFilterMode = False Then
                Selection.AutoFilter
            End If

            Cells.Select
            Selection.AutoFilter Field:=iTempCol, Criteria1:="<" & sDateTimeFilter, Operator:=xlAnd, Criteria2:="<>"
            
            Rows("2:" & lMaxRows).Delete
            
            ActiveSheet.AutoFilterMode = False

            Range(Cells(1, iTempCol), Cells(lMaxRows, iTempCol)).Clear

            Range("A2").Select
            
        End If
         
    Next Sheet
    
    ActiveWorkbook.SaveAs sFileName
     
End Sub
rizvisa1 4481 Posts Thursday January 28, 2010Registration dateContributorStatus January 6, 2016 Last seen - Apr 14, 2010 at 10:12 PM
0
Thank you
Could you please put a sample file at some shared location. It would be easier to see the issue and come up with the macro if one see how the data is and how you see it once the macro runs. One of the share site ishttp://www.speedyshare.com/ You would need to post the link to that file here
0
Thank you
Opps! Here is a sample portion of the file with the tabs

http://www.speedyshare.com/files/21950598/sample_file_v4.xls

Thanks =)
0
Thank you
Just gave this a test and it looks good, need to compare this to today's data dump. Will look the macro over and see what I can learn.

Need to add a few more lines to sort Date and Time Recv'd so rows from 2 PM the day before can be deleted along with move and delete some columns that are not needed.

Thank you so very much for your help with this, will let you know soon!
rizvisa1 4481 Posts Thursday January 28, 2010Registration dateContributorStatus January 6, 2016 Last seen - Apr 16, 2010 at 06:12 AM
0
Thank you
I have added comments to the code now, it may help you in understanding code more swiftly
0
Thank you
Ok two more quick questions about this... so far this saves a lot of time but seeing as I am required to automate as much of this as possible can the following be done...

Need to sort columns and delete from the datadump tab or prevent the data from being copied over to the West/East/Central tabs
Date Received by ascending value then Time Received by ascending value and delete anything prior to 14:00:00 hours the day before.
So for the sample file, anything on 4/12/2010 on 13:31:24 or before

Then the last part if there is an easy way to save West/East/Central to the same location as the main XLS file? Otherwise I can always just copy and paste from each of those tabs to the correct file.

Other than those two tweaks to the macro, 60% of the routine is reduce to a couple of mouse clicks so far.

Thanks again so so much for your help with this!

-Michael
rizvisa1 4481 Posts Thursday January 28, 2010Registration dateContributorStatus January 6, 2016 Last seen - Apr 20, 2010 at 07:46 AM
0
Thank you
All what you ask is possible


Need to sort columns and delete from the datadump tab or prevent the data from being copied over to the West/East/Central tabs

As far sorting goes, you can do it yourself by recording the macro. Excel provides that feature. So start the recorder and sort and stop the recorder. That will give you the code for sort. As for deletion goes,since the data has been move to sheets already, why not simple delete the sheet after the end. That too you can record via macro

Date Received by ascending value then Time Received by ascending value and delete anything prior to 14:00:00 hours the day before. So for the sample file, anything on 4/12/2010 on 13:31:24 or before
Again by recording macro you can do both

Then the last part if there is an easy way to save West/East/Central to the same location as the main XLS file? Otherwise I can always just copy and paste from each of those tabs to the correct file.
Are you saying you want save each tab as an individual file ?
0
Thank you
Thanks for the tips with the macro recorder... I do already have some macros to move & delete the data however it wont run with the macro you provided. It gives a few errors I have yet had time to resolve but in the mean time I can just run three seperate macros to achieve the same results.

As for the last part with the 3 tabs, yes I would like each tab to be saved to a seperate file. Something along the lines of
Centeral_MMDDYYYY.xls
West_MMDDYYYY.xls
East_MMDDYYYY.xls

All I am trying to achive with this process is streamline a daily task rather than the manual hands on process that is currently being done.

Thanks again,

-Michael
rizvisa1 4481 Posts Thursday January 28, 2010Registration dateContributorStatus January 6, 2016 Last seen - Apr 20, 2010 at 08:14 AM
0
Thank you
Ok i must be dense. Since you plan to delete the dump sheet as well move the resultant sheet, so what is left in original file ?
0
Thank you
Ah that is the thing, dont want to make any changes to the original file with all the tabs in it. Need to preserve that for historical & accountability purposes. that is why I was hoping to be able to save West/East/Central tabs to seperate files without touching the original tabs.
rizvisa1 4481 Posts Thursday January 28, 2010Registration dateContributorStatus January 6, 2016 Last seen - Apr 20, 2010 at 10:43 AM
0
Thank you
From what I see, from auditing purpose, either saving the complete file (with dump, accounts and generated sheets) would be desirable or at least data dump and account . Moving individual files as new files in my opinion would be less. Dont you think so?
0
Thank you
Wow Thank you for updating this! I have been enjoying throughly the first macro as it has helped reduce a daily task. The main reason why they require seperate files is due to the confusion the tabs in the spreadsheet caused when they first tried a single file. I keep for my records the entire file but as for the three districts they prefer to keep them seperated to reduce confusion on the clients end.

Also wanted to update this and say that as of now I have it working with two macros:
1) moves the data from the master sheet to the three district sheets
2) under each district I run the 2nd macro which moves columns around, deletes columns no longer needed and sorts the data.
Current when it is sorted I by hand just delete the rows that are before 14:00 hours either the day before for Tuesday through Friday or 14:00 hours for the 3rd day on Monday morning. Then I copy and paste each tab to their own district workbook, save and email.

I do need to update this and try using your version 2.0 macro as I would prefer to have a single step and reduce human error.

Now one question I had about creating a macro button on the quick access tool bar in Excel 2007. When ever I do this, it always asks me to open and enable macros for the file that I created the macro buttons under. Which then forces those macro buttons to appear in ALL excel files. Is there a way to only show them under the workbooks with the macros for the buttons?

Thanks again so so much for your help, let me know where I can click to thank you and perhaps even give more kudos for your support on this!

-Michael
rizvisa1 4481 Posts Thursday January 28, 2010Registration dateContributorStatus January 6, 2016 Last seen - May 6, 2010 at 12:14 PM
0
Thank you
I dont know if you are aware of it or not excel 2007 and 2010 create not a file. But rather a bunch of files and they are zipped together. Just rename one of your xlsx or xlsmto zip and open it you will see what i mean. The reason I bring it up is that I have heard horror stories when for no reason one day you find your file to be corrupted. The usual culprit is the xml document in that zip. Adding and removing the button will modify that xml and chances of having a corrupt file at your hand higher. So if you can stay away from buttons in 2007/2010 it will be better.
How ever if you do plan to use the buttons, then you have to code your workbook to unload those buttons as the file is closed. Under ThisWorkbook you need to do in this event

Private Sub Workbook_BeforeClose(Cancel As Boolean)

End Sub