Merge Data from multiple files into Single xlsm

Nos,
No worries with this. I have decided to go back to DSTool and use some of the enlightenment that you have afforded me to rework the code a bit so that it is applicable to AutoX. So far I am making headway. Issues are not all solved but getting there. Thanks.
 
I came up with the idea to alter the raw data in Inventory Query to remove unwanted/unneeded data that could cause undesirable issues with the loop function. I tried my best to write this on my own with research & examples and I think I did pretty good; however, the syntax is wrong for the filtering functions and I keep getting a compile error "Expected Then or GoTo Statement" here:
Code: 
If rng.AutoFilter [COLOR=#ff0000][B]Field:[/B][/COLOR]=1, Criteria1:="=1P*", _
        Operator:=xlAnd, Criteria2:="=*A" Then
        .EntireRow.Delete
Here is the full Sub:
Code: 
Private Sub ResetIQsheet()

Dim filWB As Workbook, filNam As String
Dim filPth As String
Dim lr As Long
Dim rng As Range

Application.ScreenUpdating = False

[COLOR=#008000]'Path and Name for Workbooks[/COLOR]
filPth = "C:\Users\Family\My Documents\Dads\Work\XDock\"
[COLOR=#008000]'filPth = "S:\Warehouse\Tools\XDock\"[/COLOR]

[COLOR=#008000]'Setup File Name[/COLOR]
filNam = "InventoryQuery.xlsx"

[COLOR=#008000]'Open Workbook[/COLOR]
   On Error Resume Next    'disable error notification
    Set filWB = Workbooks(filNam)
    On Error GoTo 0         're-enable error notification
    'if not already open
    If filWB Is Nothing Then
        Set filWB = Workbooks.Open(filPth & filNam)
    End If

[COLOR=#008000]'Setup lr and rng[/COLOR]
    lr = .Cells(Rows.Count, 2).End(xlUp).Row

    Set rng = Range("A1:A" & lr)

With filWB.Sheets("InventoryQuery")
     .Cells.UnMerge
     .Rows("1:9").Delete
     .Columns("A:B").Delete
 
    [COLOR=#008000]'Turn on filter if not already turned on[/COLOR]
     If ActiveSheet.AutoFilterMode = False Then rng.AutoFilter

   [COLOR=#008000] 'Delete Rows based on filtered criteria[/COLOR][COLOR=#ff0000]
     If rng.AutoFilter Field:=1, Criteria1:="=1P*", _
        Operator:=xlAnd, Criteria2:="=*A" Then
        .EntireRow.Delete
     
     If rng.AutoFilter Field:=1, Criteria1:="=1STG*", _
        Operator:=xlOr, Criteria2:="=VSL*" Then
        .EntireRow.Delete
 
     If rng.AutoFilter Field:=1, Criteria1:="=1DOOR*" Then
        .EntireRow.Delete[/COLOR]
     
   [COLOR=#008000] 'Remove Duplicates from sheet based on Column B[/COLOR]
     .Range("A:J" & lr).RemoveDuplicates Columns:=2, Header:=xlNo

   [COLOR=#008000] 'reset the usedrange[/COLOR]
     .UsedRange
         
End With
    
[COLOR=#008000]'Close Form and jump into Next Loop[/COLOR]
    Application.DisplayAlerts = False
    ActiveWorkbook.Close savechanges:=True
    Application.DisplayAlerts = True

[COLOR=#008000]'Call IQLooper[/COLOR]
    
Application.ScreenUpdating = True

End Sub
Any thoughts?
 
Last edited:
I don't see any advantage to doing that.

You establish rng from the Xdockrpt sheet to use in a "For Each cel in rng" loop.

You just need to use the same basic loop 3 separate times, once against each of the 3 other sheets.
Each time the range to search is the Item number column of the other sheet.
That will get you the fndON for each cel.
Use the offsets to copy from the appropriate column of the other sheet to the required column to the right of cel.
 
Code: 
Private Sub ResetIQsheet()
   with workbooks.open("C:\Users\Family\My Documents\Dads\Work\XDock\InventoryQuery.xlsx").Sheets("InventoryQuery")
     .Cells.UnMerge
     .Rows("1:9").Delete
     .Columns("A:B").Delete
     .columns(1).replace "1P*",""
     .columns(1).replace "*A",""
     .columns(1).replace "1STG*",""
     .columns(1).replace "1DOOR*",""
     .columns(1).specialcells(4).entirerow.delete
  end with
End Sub
 
Thanks snb. However; just to make sure I am reading this correctly.
Code: 
.columns(1).replace "1P*","" 
.columns(1).replace "*A",""
I only want to delete rows where they Begin with 1P and End with A (i.e. 1PG036A, or 1PL052A)
 
Nos,
I guess I did not clarify why I wanted to do this. Inventory Query has rows that reference invalid locations and duplicate info to the Pickfaces report. My thought was to remove all that so that I did not have to figure out how to put dis-qualifier Loops within the the Loop so that those locations would be ignored. I figured then that the primary loop would be able to just do what it does because the report would be per-cleaned.
 
Looking at this could I write this with the wild card in the middle like this?

Code: 
.columns(1)replace"1P*A",""

to get the desired result or is that incorrect syntax?
 
Rather than "Pre-Cleaning "the Inventory Query file is there a way that I can build this into a sub loop so that rather than deletion of unwanted data the process will skip over the undesired data? The code below is what I was trying to use to delete. Can it be modified to use as a sort of filter?

Code: 
'Delete Rows based on filtered criteria
     For r = .Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1

        If Range("A" & r).Value = "VSL*" Then
           Rows(r).Delete
        End If
     
        If Range("A" & r).Value = "1STG*" Then
           Rows(r).Delete
        End If
 
        If Range("A" & r).Value = "1DOOR*" Then
           Rows(r).Delete
        End If

        If Range("A" & r).Value = "1P*A" Then
           Rows(r).Delete
        End If

     Next r
 
When you ask a question like this, how do you test it ?
and why wouldn't you do it the way snb suggested ?
 
I did try it but the code locked up on this and wouldn't go any further:
Code: 
 with workbooks.open("C:\Users\Family\My Documents\Dads\Work\XDock\InventoryQuery.xlsx").Sheets("InventoryQuery")
then I got to thinking that maybe I was trying to use a sledgehammer where a screwdriver just to tweak work be a better approach.
The reason is because of your earlier post back when we were on the first loop you had said that its better not to alter the source
files if not absolutely necessary.
 
Does the file
"C:\Users\Family\My Documents\Dads\Work\XDock\InventoryQuery.xlsx"
exist ?

Does the file contain a sheet, named "InventoryQuery"

Does the file contain horrible code in the Workbook_open event ?
 
OK. I am testing the Loop. Everything prior to it works perfectly...then I get to this part.
Code: 
[COLOR=#008000]'doctor the data[/COLOR]
       [COLOR=#0000cd] For Each order In src
            order.Value = Replace(order.Value, Chr(160), "") * 1
        Next order[/COLOR]

[COLOR=#008000]'do the loop and find[/COLOR]
   [COLOR=#ff0000] For Each cel In rng
        If cel.Value <> "" Then
            Set fndON = src.Find(What:=CDbl(cel.Text), _
                                LookIn:=xlValues, _
                                LookAt:=xlWhole, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlNext, _
                                MatchCase:=False)[/COLOR]
As the code is working through the "Pickfaces" file. running the Blue code, it's converting all the item numbers to that weird excel exponent thing (i.e. 3.7890045+13) and then once it gets through the list and drops down to the code in Red it bugs out and says something about a mismatch. I know you said I'd have to play with the chr160 thing but I am not sure what I need to do to either work around it or eliminate it. I tried just commenting it out but then the Loop bugged out on the next part
Code: 
If Not fndON Is Nothing Then 'was found
                'transfer data
                cel.Offset(0, 3).Value = [COLOR=#800080]Replace(fndON.Offset(0, 1).Value, Chr(160), "")[/COLOR]
            End If
I did figure out that on the raw "Pickfaces" file that while creating it I'd have to scrub it for the rows that don't have an item number.

Any suggestions?
 
As stated earlier the times 1 coerced a text number into a real number. That's what was required in which ever previous situation that was.
You can't just copy it assuming it's going to be exactly what's needed in this situation.

If you go to the PFAssingments sheet, or whatever the name is of the one you're working with, and remove the centering formatting, what's in the cell will be left aligned if it's text and right aligned if it's real numbers.

Removing those invisible Chr(160) characters is going to leave something Excel will see as a number, even without the times 1.
So format the range to be text prior to running the replace loop.
 
I want to once again thank you and snb for the great advice and sticking with me through this. I have now fully tested and debugged AutoXrpt.xslm with the exception of the email function. I am going to study that for awhile and see what I can figure out. The VBA knowledge you have helped me to acquire is invaluable. There are still plenty of holes but at least now I can look at some code and somewhat decipher what it is trying to do.
 
snb,

what does the 4 represent in the syntax? (.Columns(1).SpecialCells(4).EntireRow.Delete)

I am working on another project which make use of several more lines like this. BTW this worked perfectly on the last...Thanks. I figured out that the 1 is the column. I thought that the 4 was the number of lines coded above it but that didn't pan out. Once I understand the Syntax I should be able to fix my other code. but just in case:
Code: 
Private Sub ManipulateData()
        
Application.ScreenUpdating = False

With Sheets("ScratchPad")
    .Cells.UnMerge
         [COLOR=#008000]'Delete Unwanted Rows and Columns[/COLOR]
         .rows("7:8").Delete
         .rows("1:5").Delete
         .Columns("F:I").Delete
         .Columns("L").Delete
         .Columns("O").Delete
          [COLOR=#008000]'Remove Rows with Unwanted Data From Column G[/COLOR]
         .Columns(7).Replace "1P*A", ""
         .Columns(7).Replace "1STG*", ""
         .Columns(7).Replace "1DOOR*", ""
         .Columns(7).Replace "VSL*", ""
         [COLOR=#ff0000].Columns(7).SpecialCells(4).EntireRow.Delete[/COLOR]
        [COLOR=#008000] 'Remove Rows with Unwanted Data From Column I[/COLOR]
         .Columns(9).Replace "1P*A", ""
         .Columns(9).Replace "1STG*", ""
         .Columns(9).Replace "1DOOR*", ""
         .Columns(9).Replace "VSL*", ""
         [COLOR=#ff0000].Columns(9).SpecialCells(4).EntireRow.Delete[/COLOR]
         [COLOR=#008000]'Remove Rows with Unwanted Data From Column C
            'Remove Repack Personel[/COLOR]
         .Columns(3).Replace "GANYAJI", ""
         .Columns(3).Replace "ANDERKA", ""
         .Columns(3).Replace "DORMADW", ""
         .Columns(3).Replace "BARNENA", ""
         .Columns(3).Replace "LONGMIC", ""
         .Columns(3).Replace "KEESLJO", ""
         .Columns(3).Replace "FAITAPA", ""
           [COLOR=#008000] ' Remove Inventory Personel[/COLOR]
         .Columns(3).Replace "MORELJO", ""
         .Columns(3).Replace "MORROCO", ""
         .Columns(3).Replace "PITTMBR", ""
           [COLOR=#008000] ' Remove Warehouse Supervisors[/COLOR]
         .Columns(3).Replace "POINDRO", ""
         .Columns(3).Replace "CARNECU", ""
         .Columns(3).Replace "MOOREDO", ""
         [COLOR=#ff0000].Columns(3).SpecialCells(12).EntireRow.Delete[/COLOR]
    
    'reset the usedrange
    .UsedRange
    
        
' apply some formatting
    With .UsedRange.Cells
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .ReadingOrder = xlContext
        .Columns.AutoFit
        .EntireRow.AutoFit
    End With
    
End With
    
' move this data to the Consolidations.Xlsm sheet
    Call MoveToIPMVTool
    
Application.ScreenUpdating = True

End Sub
View attachment Consolidations.xlsm
View attachment Consolidations.xlsx

I am also having an issue here
Code: 
Private Sub MoveToIPMVTool()

    Dim lr As Long
    
Application.ScreenUpdating = False

' transfer data to IPMVTool then delete sheet
With ActiveSheet
    lr = .Cells(rows.Count, 1).End(xlUp).Row
    [COLOR=#ff0000].UsedRange.Offset(0).Resize(lr - 1).Copy Sheets("Consolidations").Range("A2")[/COLOR]
    Application.DisplayAlerts = False
    .Delete 'deletes ScratchPad
    Application.DisplayAlerts = True
End With

'put in the borders
    Call PutInBorders
    
Application.ScreenUpdating = True

End Sub
I keep getting an out of Range error and I don't know where to look to solve it. Nearly every piece of code was borrowed from the previous project so that is why I feel it still applies to this thread.

Thank you up front.
 
Use every resource available: F1 in VBEditor to read about specialcells and its arguments; F2 in the VBEditor to read about specialcells en its arguments, F8 to step through the code; the mouse to convey the value of every variable in the step by step method, the loacsl window in the VBEditor to evaluate the values of all variables. Until you do not understand the code completely: do not use it.
 
You must log in or register to reply here.
Back
Top