Merge Data from multiple files into Single xlsm

robertwp7472 · Sep 24, 2016

Hello All,
I have visited this Forum Many times and gotten a considerable amount of help, special thanks to NoS.

I have been working on my newest project and I am having Compile errors on the For/Next Loops and general Debugging issues.
Let me start by saying that I am very new to VBA coding and I am sure that my code is clunky and will have syntax errors.

What I am posting is my first attempt to construct code mostly on my own with help from borrowing snippets of code my previous projects and reorganizing it to the best of my ability. I know that some of it is probably incorrect or unnecessary at best but I tried to follow the path of programming logic in order to go step by step.

At this point I have gone as far as I can with my own skill set and lots of Google searching as well as seeking help from the Mr. Excel and Ozgrid forums.

Please feel free to change any code as needed, but to enable my learning of what I did wrong I would like to request that you comment out my code while inserting yours.

[FONT=&quot]Thank you all for any help on this.

Code:

Sub BuildXdock()

     '1.)Retrieve Data from Xdock Raw and Format
     
     '2.)Compare Item Number Data against PFAssingments.xlsx and retrieve PickFace
        'location data
        
     '3.)Compare Item Number Data against InventoryQuery.xlsx and retrieve Location of
        'oldest Lot for that item.
        
     '4.)Compare Item Number Data against Tacoma PSR.xlsx and retrive Product availability
        'data and cut code if any
        
     '5.)In relation to Step 2, if No Pickface is assigned email Inventory Team
        'to create New Pickface for item number
     
    Dim wb1 As Workbook, wb2 As Workbook, wb3 As Workbook, wb4 As Workbook, wb5 As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, ws4 As Worksheet, ws5 As Worksheet
    Dim wb2Loc As String, ws2Name As String
    Dim wb3Loc As String, ws3Name As String
    Dim wb4Loc As String, ws4Name As String
    Dim wb5Loc As String, ws5Name As String
    Dim lr As Long, R As Long, I As Long, N As Long, G As Long
    
        
Application.ScreenUpdating = False
Application.EnableEvents = False

'Change to your target workbook name
wb2Loc = "C:\Users\Family\My Documents\Dads\Work\XDock\Xdockrpt.xlsx"
'wb2loc = "S:\Warehouse\Tools\XDock\Xdockrpt.xlsx

wb3Loc = "C:\Users\Family\My Documents\Dads\Work\XDock\PFAssingments.xlsx"
'wb3loc = "S:\Warehouse\Tools\XDock\PFAssingments.xlsx

wb4Loc = "C:\Users\Family\My Documents\Dads\Work\XDock\InventoryQuery.xlsx"
'wb4loc = "S:\Warehouse\Tools\XDock\InventoryQuery.xlsx

wb5Loc = "C:\Users\Family\My Documents\Dads\Work\XDock\Tacoma PSR.xlsx"
'wb5loc = "S:\Warehouse\Tools\XDock\Tacoma PSR.xlsx


'Change to the sheet name you want to get specific data from
ws2Name = "Xdockrpt"
ws3Name = "PFAssingments"
ws4Name = "InventoryQuery"
ws5Name = "Tacoma PSR"

Set wb1 = ThisWorkbook
Set ws1 = wb1.ActiveSheet

Set wb2 = Workbooks.Open(Filename:=wb2Loc)
Set ws2 = wb2.Sheets(ws2Name)

Set wb3 = Workbooks.Open(Filename:=wb3Loc)
Set ws3 = wb3.Sheets(ws3Name)

Set wb4 = Workbooks.Open(Filename:=wb4Loc)
Set ws4 = wb4.Sheets(ws4Name)

Set wb5 = Workbooks.Open(Filename:=wb5Loc)
Set ws5 = wb5.Sheets(ws5Name)

'------------------------------
'|Begin Work with Raw Xdockrpt|
'------------------------------

'Remove any unneeded Rows/Colums from "Xdockrpt"
With ws2
    ActiveSheet.Cells.UnMerge
    Dim delrng As Range
    Dim Xsht As Range
        
    Set delrng = Range("A1:K7")
    Set Xsht = ActiveSheet.UsedRange
    
    lr = .Cells(Rows.Count, 1).End(xlUp).Row
    
    'Delete Rows 1-4, 6 & 7
    With delrng
      If .Cells(A) = "" Then .EntireRow.Delete
    End With
    
    'Delete Column G & Move current Column I to A
    With Xsht
       .Columns("G").Delete
       .Columns("I:I").Cut
       .Columns("A:A").Insert Shift:=xlToRight
    
    'Stuff has been moved, get new lr
    lr = .Cells(Rows.Count, 1).End(xlUp).Row
    
    'Create new header for I
       .Range("I1").Value = "PickFace"
       
    'Transfer desired Data from PFAssingments (ws3) to Xdockrpt (ws2)
     For R = .Cells(Rows.Count, 1).End(xlUp).Row To 3 Step -1
       If ws3.Range("B1:B" & lr).Value = ws2.Range("F2:F" & lr).Value Then
          ws3.Range("A1:A" & lr).Value.Copy
          ws2.Range("I2:I" & lr).Value.Paste
       Else: ws2.Range("I2:I" & lr).Value = "No Pickface"
       End If
     'Send Email to Inventory Control Team if "No Picface"
       If ws2.Range("I2:I" & lr).Value = "No Pickface" Then
       Call EmailIC
     Next R
      
     'Create new header for J
       .Range("J1").Value = "Get Old"
       
     'Transfer desired Data from InventoryQuery (ws4) to Xdockrpt (ws2)
     '----------------------------------------------------------------------
     '|On this set I am not sure how to code so that it only transfers the |
     '|information from ws4 that contains the oldest Lot Date and at the   |
     '|same time does not equal the Pick Face value already in "I" from the|
     '|previous function                                                   |
     '----------------------------------------------------------------------
     For I = .Cells(Rows.Count, 1).End(xlUp).Row To 3 Step -1
       If ws4.Range("D10:D" & lr).Value = ws2.Range("F2:F" & lr).Value Then
          ws4.Range("C10:C" & lr).Value.Copy 'Location of Oldest Lot Date
          ws2.Range("J2:J" & lr).Value.Paste
       End If
     Next I
     
     'Create new header for K
       .Range("K1").Value = "PSR Data"
       
     'Transfer Item Recovery Data from Tacoma PSR (ws5) to Xdockrpt (ws2)
     For N = .Cells(Rows.Count, 1).End(xlUp).Row To 3 Step -1
       If ws5.Range("A2:A" & lr).Value = ws2.Range("F2:F" & lr).Value Then
          ws5.Range("C2:C" & lr).Value.Copy
          ws2.Range("K2:K" & lr).Value.Paste
       End If
     Next N
     
     'Create new header for L
       .Range("L1").Value = "Cut Code"
     
     'Transfer Cut Codes from Tacoma PSR (ws5) to Xdockrpt (ws2)
     For G = .Cells(Rows.Count, 1).End(xlUp).Row To 3 Step -1
       If ws5.Range("A2:A" & lr).Value = ws2.Range("F2:F" & lr).Value Then
          ws5.Range("D2:C" & lr).Value.Copy
          ws2.Range("L2:L" & lr).Value.Paste
       End If
     Next G
     
     ' reset usedrange
       ActiveSheet.UsedRange
    End With
End With

' close the source workbook wb2
wb2.Close False

' |~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~|
' | EVERYTHING FROM HERE ON IS DEALING WITH SHEET1 (AutoXrpt) |
' |~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~|

Dim Br As Long

'Copy UedRange of Xdockrpt (ws2) to AutoXrpt (ws1)
ws2.UsedRange.Copy Destinaton:=ws1("A2")

With ws1
    ' reset usedrange, not really necessary, I just do it
    ' became necessary for the border formatting
    ActiveSheet.UsedRange
    
    'changes hav been made, get new lr
    lr = .Cells(Rows.Count, 1).End(xlUp).Row
    
    ' sort data by "Appointment Time" Then by "Order Number"
    With .Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("A2"), SortOn:=xlSortOnValues, _
                    Order:=xlAscending, DataOption:=xlSortTextAsNumbers
        .SortFields.Add Key:=Range("D2"), SortOn:=xlSortOnValues, _
                    Order:=xlAscending, DataOption:=xlSortTextAsNumbers
        .SetRange Range("A2:L" & lr)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    ' add a little formatting
    .Rows(1).Font.Bold = True
    .Cells.HorizontalAlignment = xlCenter
    .Cells.VerticalAlignment = xlCenter
    .Cells.EntireColumn.AutoFit
    
    ' Insert blank row between different order numbers
    lr = Cells(Rows.Count, 1).End(xlUp).Row
    For Br = lr - 1 To 3 Step -1
    If Cells(C, 1) <> Cells(C + 1, 1) Then
        Cells(C + 1, 1).EntireRow.Insert
        Range("A" & L + 1 & ":L" & L + 1).Interior.ColorIndex = 0
    End If
    Next Br
    
    ' apply borders to used range, but not row 1
    With .UsedRange.Offset(1).Resize(lr - 1).Borders
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    
End With
Application.ScreenUpdating = True

End Sub
Private Sub EmailIC()

'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
'This macro adapted from: http://www.rondebruin.nl/win/s1/outlook/bmail4.htm

    Dim OutApp As Outlook.Application
    Dim OutMail As Outlook.MailItem
    Dim wb2Loc As String, wb2 As Workbook, ws2 As Worksheet, ws2Name As String
    Dim lr As Long
    
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(olMailItem)
    
    'Change to your target workbook name
    wb2Loc = "C:\Users\Family\My Documents\Dads\Work\XDock\Xdockrpt.xlsx"
    'wb2loc = "S:\Warehouse\Tools\XDock\Xdockrpt.xlsx
    ws2Name = "Xdockrpt"
    
    On Error Resume Next
    With OutMail
        .To = "jorge.morelles.contractor@pepsico.com"
        .CC = "cory.morrow.contractor@pepsico.com"
        .BCC = ""
        .Subject = "Need Pick Face please!"
        .Body = ws2.Range("F2:F" & lr).Value
        .Send
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

View attachment InventoryQuery.xlsx
View attachment AutoXrpt.xlsm
View attachment Xdockrpt.xlsx
View attachment Tacoma PSR.xlsx
View attachment PFAssingments.xlsx

[/FONT]

robertwp7472 · Sep 26, 2016

I have also posted this thread on the Ozgrid forum http://www.ozgrid.com/forum/showthread.php?t=201249

robertwp7472 · Sep 26, 2016

I have also cross posted on the Mr. Excel Forum.

http://www.mrexcel.com/forum/excel-...s-into-single-xlsm-debugging.html#post4640634

NoS · Sep 27, 2016

If this were my project, and it isn't, first thing I'd do is copy the sheets from the four .xlsx files into AutoXrpt.xlsm and work with everything in one workbook.
(Actually that's the second thing, first would be use OPTION EXPLICIT)

Why ?
1) Won't screw up the raw data files because only working with a copy.
2) Can rename the sheets when copying. Currently 50% of the sheet names being assingning to ws2 - ws5 don't exist.
3) Easier working with one workbook than five.
4) Easier to see what's actually taking place when single stepping through the code with F8. (Ctrl + right arrowkey will place VBE on half screen)
5) Simple to delete the sheets and start over if something doesn't work.

~~~~~~~

With this part of your code

Code:

'Remove any unneeded Rows/Colums from "Xdockrpt"
With ws2
    ActiveSheet.Cells.UnMerge
    Dim delrng As Range
    Dim Xsht As Range
        
    Set delrng = Range("A1:K7")
    Set Xsht = ActiveSheet.UsedRange
    
    lr = .Cells(Rows.Count, 1).End(xlUp).Row
    
    'Delete Rows 1-4, 6 & 7
    With delrng
      If .Cells(A) = "" Then .EntireRow.Delete
    End With
    
    'Delete Column G & Move current Column I to A
    With Xsht
       .Columns("G").Delete
       .Columns("I:I").Cut
       .Columns("A:A").Insert Shift:=xlToRight
    
    'Stuff has been moved, get new lr
    lr = .Cells(Rows.Count, 1).End(xlUp).Row
    
    'Create new header for I
       .Range("I1").Value = "PickFace"
       
    'Transfer desired Data from PFAssingments (ws3) to Xdockrpt (ws2)
     For R = .Cells(Rows.Count, 1).End(xlUp).Row To 3 Step -1
       If ws3.Range("B1:B" & lr).Value = ws2.Range("F2:F" & lr).Value Then
          ws3.Range("A1:A" & lr).Value.Copy
          ws2.Range("I2:I" & lr).Value.Paste
       Else: ws2.Range("I2:I" & lr).Value = "No Pickface"
       End If
     'Send Email to Inventory Control Team if "No Picface"
       If ws2.Range("I2:I" & lr).Value = "No Pickface" Then
       Call EmailIC
     Next R

I'd suggest removing or commenting this bit out until after you get the rest working.
This will also eliminate a For-Next error.

Code:

     'Send Email to Inventory Control Team if "No Picface"
       If ws2.Range("I2:I" & lr).Value = "No Pickface" Then
       Call EmailIC

the top part can be reduced to something like

Code:

With ws2
    .Cells.UnMerge
    .Rows("6:7").Delete
    .Rows("1:4").Delete
    .Columns("G").Delete
    .Columns("I").Cut
    .Columns("A").Insert
    .Range("I1").Value = "PickFace"
End With

You'll need to put into words what this part is supposed to accomplish

Code:

    'Transfer desired Data from PFAssingments (ws3) to Xdockrpt (ws2)
     For R = .Cells(Rows.Count, 1).End(xlUp).Row To 3 Step -1
       If ws3.Range("B1:B" & lr).Value = ws2.Range("F2:F" & lr).Value Then
          ws3.Range("A1:A" & lr).Value.Copy
          ws2.Range("I2:I" & lr).Value.Paste
       Else: ws2.Range("I2:I" & lr).Value = "No Pickface"
       End If
       ' bit removed 
    Next R

robertwp7472 · Sep 28, 2016

I made some of the suggested changes.

Code:

[COLOR=#008000]'Remove any unneeded Rows/Colums from "Xdockrpt"[/COLOR]
With ws2
    .Cells.UnMerge
    .Rows("6:7").Delete
    .Rows("1:4").Delete
    .Columns("G").Delete
    .Columns("I").Cut
    .Columns("A").Insert
   [COLOR=#008000] 'Create new header for I[/COLOR]
    .Range("I1").Value = "PickFace"
    [COLOR=#008000]'Create new header for J[/COLOR]
    .Range("J1").Value = "Get Old"
   [COLOR=#008000] 'Create new header for K[/COLOR]
    .Range("K1").Value = "PSR Data"
   [COLOR=#008000] 'Create new header for L[/COLOR]
    .Range("L1").Value = "Cut Code"
End With

Looks much cleaner. Thanks. From previous advice you provided me to make use of a scratch-sheet I though that I could make all the needed changes to Xdockrpt as my scratch-sheet and then pull it over to AutoXrpt.xlsm at the end. Am I misguided here?

You'll need to put into words what this part is supposed to accomplish

Here is what I have:

Code:

[COLOR=#008000]    'Transfer Pickface Location Data from PFAssignments.xlxs
    '(ws3) Column"A"to Xdockrpt.xlsx (ws2)Column "I"[/COLOR]
    
    For R = .Cells(Rows.Count, 1).End(xlUp).Row To 3 Step -1
       If ws3.Range("B1:B" & lr).Value = ws2.Range("F2:F" & lr).Value Then
          ws3.Range("A1:A" & lr).Value.Copy
          ws2.Range("I2:I" & lr).Value.Paste
       Else: ws2.Range("I2:I" & lr).Value = "No Pickface"
       End If
     [COLOR=#008000]'Send Email to Inventory Control Team if "No Picface" [/COLOR][COLOR=#b22222](Temporarily Suppressed)[/COLOR][COLOR=#008000]
       'If ws2.Range("I2:I" & lr).Value = "No Pickface" Then
       'Call EmailIC[/COLOR]
     Next R

Is my syntax correct? The reason I ask is because I was trying to follow a process of "If A=B Then Do C". I know you told me to use "K.I.S.S." but I get the feeling that I am either mis-directing my code or simply overthinking what needs to be.

NoS · Sep 28, 2016

From previous advice you provided me to make use of a scratch-sheet I though that I could make all the needed changes to Xdockrpt as my scratch-sheet and then pull it over to AutoXrpt.xlsm at the end. Am I misguided here?

Not necessarily. I just make too many screw ups to consider the actual raw data file a "scratch-sheet" to be played with.

Here is what I have:

That's the same as I questioned what's it supposed to do.

Is my syntax correct? The reason I ask is because I was trying to follow a process of "If A=B Then Do C".

For the first loop of R, or any loop of R, what are you considering to be A, B and C? a value in a cell (what row, what column, what sheet) or a whole column of cells?

robertwp7472 · Sep 28, 2016

That's the same as I questioned what's it supposed to do.

If you refer to the comments at the very top of the code I have broken everything down into steps. this is step 2

Code:

[FONT='inherit']
'2.)Compare Item Number Data against PFAssingments.xlsx and retrieve PickFace    'location data

but I realize that this is a bit vague. So to expand...

All 4 files have one piece of data in common... "Item Number". XDockrpt is the base sheet and after the line/column changes
its item number column is in "F" with header in "F1" hence the "= ws2.Range("F2:F" & lr).Value Then" In all the loops.
Each Loop seeks to compare the contents of XDockrpt "F" to the "Item Number" data in each of the other files then report back
with corresponding data from another column if there is a match. So for the first loop...

If the item number in ws3 matches the item number in ws2

Code:

If ws3.Range("B1:B" & lr).Value = ws2.Range("F2:F" & lr).Value Then

copy Pickface info from Column "A" in ws3

Code:

ws3.Range("A1:A" & lr).Value.Copy

and transfer it to Column "I" on ws2

Code:

ws2.Range("I2:I" & lr).Value.Paste

If there is no match found to the "Item Number" the result in ws2 "I" is to be "No Pickface"

Code:

 Else: ws2.Range("I2:I" & lr).Value = "No Pickface"

Each one of the loops attempts to have the same basic process.

[/FONT]

NoS · Sep 28, 2016

Re-visit the CPSteps1and2 sub of one of your previous projects and examine the 'what to loop through', 'where to find it' and 'do the loop and find' parts.

robertwp7472 · Sep 29, 2016

Great Advice. Thanks. I started digging in to that code and realized that with only a few changes it could be adapted easy enough so I reworked it a bit to see if it could take the place of what I had and I like it but there is one place in particular where I get lost. I will post the whole thing and highlight the area.

Code:

Sub BuildX()
    Dim srcWB1 As Workbook, Dim srcWB2 As Workbook, Dim srcWB3 As Workbook, Dim dstWB As Workbook
    Dim strPath As String, dstName As String
    Dim srcName1 As String, srcName2 As String, srcName3 As String
    Dim src As Range, order As Range
    Dim rng As Range, cel As Range, fndON As Range
    Dim src_lr As Long, dst_lr As Long
    Dim d As Object, c As Variant, i As Long, lr As Long, j As Integer
    Dim crit As String, filtRng As Range, Ltot As Double
    
Application.ScreenUpdating = False

'Path and Name for Workbooks
strPath = "C:\Users\Family\My Documents\Dads\Work\XDock\"
'strPath = "S:\Warehouse\Tools\XDock\"

'Setup calls to source files
srcName1 = "Pickfaces.xlsx"
srcName2 = "InventoryQuery.xlsx"
srcName3 = "Tacoma PSR.xlsx"

'Set Destination file
dstName = "Xdockrpt.xlsx"

'set source
    On Error Resume Next    'disable error notification
    Set srcWB1 = Workbooks(srcName1)
    On Error GoTo 0         're-enable error notification
    'if not already open
    If srcWB1 Is Nothing Then
        Set srcWB1 = Workbooks.Open(strPath & srcName1)
    End If

'set destination
    On Error Resume Next    'disable error notification
    Set dstWB = Workbooks(dstName)
    On Error GoTo 0         're-enable error notification
    'if not already open
    If dstWB Is Nothing Then
        Set dstWB = Workbooks.Open(strPath & dstName)
    End If

'set what to loop through on XDockrpt
    With dstWB.Sheets("XDockrpt")
         .Cells.UnMerge
         .Rows("6:7").Delete
         .Rows("1:4").Delete
         .Columns("G").Delete
         .Columns("I").Cut
         .Columns("A").Insert
         'Create new header for I
         .Range("I1").Value = "PickFace"
         'Create new header for J
         .Range("J1").Value = "Get Old"
         'Create new header for K
         .Range("K1").Value = "PSR Data"
         'Create new header for L
         .Range("L1").Value = "Cut Code"
         dst_lr = .Cells(Rows.Count, "L").End(xlUp).Row
         Set rng = .Range("F2:F" & dst_lr)
    End With

'set where to find it in Pickfaces
   [COLOR=#0000ff] With srcWB1
         src_lr = .Sheets("Sheet1").Cells(Rows.Count, 2).End(xlUp).Row
         Set src = srcWB1.Sheets("Sheet1").Range("B1:B" & src_lr)
    End With[/COLOR]
    'doctor the data
        For Each order In src
            order.Value = Replace(order.Value, Chr(160), "") * 1
        Next order

'do the loop and find
    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=#ff0000] If Not fndON Is Nothing Then 'was found
                'transfer data
                cel.Offset(0, 1).Value = Replace(fndON.Offset(0, 1).Value, Chr(160), "")
            End If
        End If
    Next cel
[/COLOR]
'close the source
    srcWB1.Close False
    Set srcWB1 = Nothing

Application.ScreenUpdating = True

End Sub

I am am pretty sure I got it right for the bulk of it and I do understand that for each file that I access I'll have to "Lather, Rinse, Repeat". This is not an issue. Code in Red has me a bit flustered. On the source file "Pickfaces" (formerly PFassignments) the match data is in column B (Blue code) and the data to be transferred is in column A. Did I correctly reset the Syntax for this? If so, then I understand what I need to do for the rest. If not please steer me in the right direction, or tell me if its FUBAR.

If I have done this correctly... This code should access XDockrprt, reset its structure, then compare column F in Xdockrpt to column B in Pickfaces, if/when a match occurs it will get the corresponding data from column A in Pickfaces and transfer it to column I in XDockrpt.

The only other thing I need help with is how to get it to put "None" or "N/A" into column I if there is no match found.

NoS · Sep 29, 2016

Re the red: the range.Find method is used to find the What:=xxxx
It either finds it or it doesn't.
If it does then the range fndON is set to the cell where found.
If it doesn't then VBA sets the range fndON to Nothing.
So, if fndON is Not Nothing then it is the cell where it was found.
The VBA syntax to say that is

Code:

If Not fndON Is Nothing then
    'it was found so do something
Else
    'it was not found so do something else
End If

You will probably need to experiment with the 'doctor the data' part.
With what's there the times 1 part coerces a text number to a real number.
Your last project you indicated a need to specify things as text so you'll need to test things to see what works.

robertwp7472 · Sep 30, 2016

OK...I have Googled this till I can't see straight and I still can't figure out the syntax for the offset...I think. In "Pickfaces" the data to be matched is in Column B and the data to be transferred to Xdockrpt if a match occurs is in Column A.

I think I am getting that the .Offset(x,x) is (Rows in addition to row 1, Columns in addition to A) is this correct?

and if so that would mean this:

Code:

[COLOR=#ff0000]
'transfer data[/COLOR][COLOR=#ff0000]
cel.Offset(0, 1).Value = Replace(fndON.Offset(0, 1).Value, Chr(160), "")
[/COLOR]

would need to be....

Code:

[COLOR=#4b0082]cel.Offset(0,0).Value = Replace(fndOn.Offset(1,8).Value, Chr(160), "")[/COLOR]

because that makes it look at Row 1 column A, and send result to Row 2 Column 8 or "I2"

Did I get that right?

NoS · Sep 30, 2016

No.

The offset is from the specified range. Range being either cel or fndON.
Both of these variables have been declared as range and both will be single cells.

cel.offset(0,0) would be cel itself as the offset is (zero rows, zero columns)
cel.offset(2,2) would be the cell that is 2 rows down and 2 columns to the right of cel.
cel.offset(-2,-10) would be the cell 2 rows up and 10 columns to the left from cel
cel.offset(0,-1) would be the cell same row, one column to the left of cel.

Before you get this far though, you need to think about what you want to loop through.
I mention this because of the For each cel in rng loop.
You indicate the value in column A of PFassigments being the offset of cel going to the offset of fndON (column I).

The Item number column of Xdockrpt is 63 rows. The Item number column of PFAssingments is 1198 rows.
Do you want to do 63 loops knowing these are the only items you're really interested in and 100% of the loops are meaningful, or do you want to do 1198 loops ?

Another reason to loop the column of Xdockrpt, there's duplicate item numbers. The loop will include them all.
PFAssingments has unique item numbers for all the ones that are set.

robertwp7472 · Sep 30, 2016

Very cool...

I scanned through 20-30 web pages seeking advice on cell offset and not one laid it out as simply and straight forward as you just did. Now I completely understand how it works.

The Item number column of Xdockrpt is 63 rows. The Item number column of PFAssingments is 1198 rows.
Do you want to do 63 loops knowing these are the only items you're really interested in and 100% of the loops are meaningful, or do you want to do 1198 loops ?

All four files are daily downloads and change in length and content. Although the "Pickfaces" file is the most stable and could potentially be a weekly update, they are all dynamic in character.

"XDock" works off of Order Date/Time and Order Number for its final sort once its copied to AutoXrpt.xlsm for final formatting and printing (Not at that step yet). So as a result of this, it will need to loop through the "XDock" and produce the duplicate results if applicable. So yes... with the example file given it would need to loop the 63.

I also need it to produce a result of "None" if it does not find a match. This will eventually drive the automatic email to the IC team (Not there yet either).

NoS · Sep 30, 2016

I also need it to produce a result of "None" if it does not find a match.

This dictates that the For each cel in rng MUST be the list column of Xdockrpt, other wise you wouldn't know where to put the "None".

see post #10.

robertwp7472 · Sep 30, 2016

So...since the rng to be looped through in XDock starts at "F2" then (if I am reading your instructions correctly), the offset should look like this:

Code:

cel.Offset(0, -1).Value = Replace(fndON.Offset(0, -1).Value, Chr(160), "")

fndOn is "Pickfaces"
so since the search and result both start in Row 1 then 0
and since result is one row to the left of the search then -1

Do I have any hope Dr. NoS? or do we need to call the coroner?

NoS · Sep 30, 2016

Now that's funny :laugh:

See if this helps clarify things.
I'm using the files you posted, so where you refer to "Pickfaces" I'm using "PFAssingments".

Unless I'm really missing something the Item numbers on the Xdockrpt sheet are the ones to look for on all the other sheets.

The rng to cycle through with the loop is Xdockrpt column F, so each cel is a single cell range such as F2.
The place to search, looking for the value that's in F2, within PFAssingments is column B.

On the first loop, cel is F2 and cel.value is found in PFAssingments column B on row 376, so that will be fndON.

You're wanting to copy the value of PFAssingments column A (which is one column to the left of fndON) to Xdockrpt column I (which is 3 columns to the right of cel).
The VBA statement for this is

Code:

cel.Offset(0, 3).Value = fndON.Offset(0, -1).Value

This isn't a true copy and paste statement, it's a statement that makes one cell equal to another cell, making it appear somewhat 'backwards' to copy-paste.

robertwp7472 · Sep 30, 2016

Thanks. That's what was probably confusing me. Like Spanish to English. I do believe that I have this first loop straight now . So that I can see the result in "AutoXrpt.xlsm" this is what I have:

Code:

'Copy Xdockrpt.xlsx data to the AutoXrpt.xlsm sheet
    dstWB.Usedrange.copy 
    Activesheet.Range(A2).PasteSpecial xlValues

I have found many other examples but they are complex and don't seem to fit what I need. Will this do what need?

robertwp7472 · Oct 1, 2016

Here is another that I put together with a combination of Macro Recorder and some thought.

Code:

'Copy Xdockrpt.xlsx data to the AutoXrpt.xlsm sheet
    dstWB.Sheets.Usedrange.Copy
    Windows("AutoXrpt.xlsm").Activate
    Range("A2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

snb · Oct 1, 2016

I'd suggest you start with a course in the basics of VBA, either by book or by live training.

Excel VBA Programming For Dummies by John Walkenbach | 9781119077398 | Paperback | Barnes & Noble

After that you don't need a personal trainier like NoS anymore.

robertwp7472 · Oct 1, 2016

Thank you for the suggestion snb. I actually already have that book but I found it to be unhelpful at best. That is why I began using the forums. Sometimes getting pointed in the correct direction when you're having a difficult issue helps you through the weeds. When I read through the book, for me, the weeds turned into a swamp with alligators.

Merge Data from multiple files into Single xlsm

New member

New member

New member

Member

New member

Member

New member

Member

New member

Member

New member

Member

New member

Member

New member

Member

New member

New member

New member

New member