Transferring data utilising VBA

bedsy · May 23, 2023

Hi All,

I am trying to have code open and run through each workbook in the respective folder and return certain values from the sumifs that have multiple criteria multiple criteria.

Most of the code functions as required but the part I struggle with is having the arrival and departure details on separate worksheets and want them to input in the same worksheet.

the data pulled from sheet 1 ("Arrivals") will be in column "A" (OperatorName), "B" (Product), "C" (Arrival ID), "G" (wagons), "I" (Arrival time).
the data pulled from sheet 2 (Departures" will be in column "C" (DepartureID), "H" (Departure time)

In addition, if the source sheet has multiple instances that match the criteria it adds them and inputs the total value whereas I need it to input each occasion and not sure how to convert the code.

Also, I need to record the date of each respective record in Column "A". This is in Cell "O2" of each workbook.

Question: the time field in the source worksheet is formatted using 'Special - codigo Postal' to prevent having to insert ":" for each time input. any way for VBA to convert this back to a time format e.g 1745 becomes 17:45:00

Below is the code I currently have and a snapshot of the worksheet I need the data to be added to.

VBA Code:

Sub OpenBooks()
  Dim sPath As String, MyFiles As String
  Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet
  Dim wb2 As Workbook
  Dim i As Long
 
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
 
  Set sh3 = ThisWorkbook.Sheets("Staged wagons")

  With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Select Folder"
    If .Show <> -1 Then Exit Sub
    sPath = .SelectedItems(1) & "\"
  End With
 
  i = 1   'initial row to put the data
 
  MyFiles = Dir(sPath & "*.xlsx")
  Do While MyFiles <> ""
    Set wb2 = Workbooks.Open(sPath & MyFiles)
    Set sh2 = wb2.Sheets("Arrivals")
    With wb2.Sheets("Arrivals").Activate
    End With
    
    sh3.Range("B" & i + 2).Value = WorksheetFunction.SumIfs(sh2.Range("OperatorName"), sh2.Range("A4:A26"), "Operator", sh2.Range("B4:B26"), "Product") 'Operator
    sh3.Range("C" & i + 2).Value = WorksheetFunction.SumIfs(sh2.Range("G4:G26"), sh2.Range("A4:A26"), "Operator", sh2.Range("B4:B26"), "Product") ' wagons
    sh3.Range("E" & i + 2).Value = WorksheetFunction.SumIfs(sh2.Range("C4:C26"), sh2.Range("A4:A26"), "Operator", sh2.Range("B4:B26"), "Product") 'ID arrival
    sh3.Range("G" & i + 2).Value = WorksheetFunction.SumIfs(sh2.Range("M4:M26"), sh2.Range("A4:A26"), "Operator", sh2.Range("B4:B26"), "Product") 'actual arrival time
With wb2.Sheets("Departures").Activate
End With
    sh3.Range("H" & i + 2).Value = WorksheetFunction.SumIfs(sh2.Range("C4:C26"), sh2.Range("A4:A26"), "Operator", sh2.Range("B4:B26"), "Product") 'ID Depature
    sh3.Range("G" & i + 2).Value = WorksheetFunction.SumIfs(sh2.Range("H4:H26"), sh2.Range("A4:A26"), "Operator", sh2.Range("B4:B26"), "Product") 'actual depart time
        i = i + 1
    wb2.Close False

    MyFiles = Dir()
  Loop
 
  Application.ScreenUpdating = True
  Application.DisplayAlerts = True
End Sub

Thanks Bedsy.

sijpie · May 29, 2023

Try the code below. Read through the comments to see what I changed and where I think things went wrong.

VBA Code:

Option Explicit

Sub OpenBooks()
  Dim sPath As String, MyFiles As String
  Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet
  Dim wb2 As Workbook
  Dim lR As Long    'for Long variables use a l to start and _
                    a meaningful letter for the name. in this case you want it to count rows, _
                    so I then always use a R to show that meaning: lR _
                    It makes your code easier to rwad and maintain that way
 
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
 
  Set sh3 = ThisWorkbook.Sheets("Staged wagons")

  With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Select Folder"
    If .Show <> -1 Then Exit Sub
    sPath = .SelectedItems(1) & "\"
  End With
 
  lR = 1   'initial row to put the data
 
  MyFiles = Dir(sPath & "*.xlsx")
  Do While MyFiles <> ""
    Set wb2 = Workbooks.Open(sPath & MyFiles)
    Set sh2 = wb2.Sheets("Arrivals")
    Set sh1 = wb2.Sheets("Departures")  ' <<< I have added this line
'    With wb2.Sheets("Arrivals").Activate   'You don't need to activate a sheet in order to work with it. Takes time...
'    End With
    
    sh3.Range("B" & lR + 2).Value = WorksheetFunction.SumIfs(sh2.Range("OperatorName"), sh2.Range("A4:A26"), "Operator", sh2.Range("B4:B26"), "Product") 'Operator
    sh3.Range("C" & lR + 2).Value = WorksheetFunction.SumIfs(sh2.Range("G4:G26"), sh2.Range("A4:A26"), "Operator", sh2.Range("B4:B26"), "Product") ' wagons
    sh3.Range("E" & lR + 2).Value = WorksheetFunction.SumIfs(sh2.Range("C4:C26"), sh2.Range("A4:A26"), "Operator", sh2.Range("B4:B26"), "Product") 'ID arrival
    sh3.Range("G" & lR + 2).Value = WorksheetFunction.SumIfs(sh2.Range("M4:M26"), sh2.Range("A4:A26"), "Operator", sh2.Range("B4:B26"), "Product") 'actual arrival time
'With wb2.Sheets("Departures").Activate
'End With

    '!!!! you were referring to sh2 in the lines below. sh2 was set to the 'Arrivals' sheet, not the 'Departure sheet' . It now uses the Departure sheet data
    sh3.Range("H" & lR + 2).Value = WorksheetFunction.SumIfs(sh1.Range("C4:C26"), sh1.Range("A4:A26"), "Operator", sh1.Range("B4:B26"), "Product") 'ID Depature
    sh3.Range("G" & lR + 2).Value = WorksheetFunction.SumIfs(sh1.Range("H4:H26"), sh1.Range("A4:A26"), "Operator", sh1.Range("B4:B26"), "Product") 'actual depart time
        lR = lR + 1
    wb2.Close False

    MyFiles = Dir()
  Loop
 
  Application.ScreenUpdating = True
  Application.DisplayAlerts = True
End Sub

bedsy · May 29, 2023

sijpie said:

Try the code below. Read through the comments to see what I changed and where I think things went wrong.

VBA Code:

Option Explicit

Sub OpenBooks()
  Dim sPath As String, MyFiles As String
  Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet
  Dim wb2 As Workbook
  Dim lR As Long    'for Long variables use a l to start and _
                    a meaningful letter for the name. in this case you want it to count rows, _
                    so I then always use a R to show that meaning: lR _
                    It makes your code easier to rwad and maintain that way
 
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
 
  Set sh3 = ThisWorkbook.Sheets("Staged wagons")

  With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Select Folder"
    If .Show <> -1 Then Exit Sub
    sPath = .SelectedItems(1) & "\"
  End With
 
  lR = 1   'initial row to put the data
 
  MyFiles = Dir(sPath & "*.xlsx")
  Do While MyFiles <> ""
    Set wb2 = Workbooks.Open(sPath & MyFiles)
    Set sh2 = wb2.Sheets("Arrivals")
    Set sh1 = wb2.Sheets("Departures")  ' <<< I have added this line
'    With wb2.Sheets("Arrivals").Activate   'You don't need to activate a sheet in order to work with it. Takes time...
'    End With
   
    sh3.Range("B" & lR + 2).Value = WorksheetFunction.SumIfs(sh2.Range("OperatorName"), sh2.Range("A4:A26"), "Operator", sh2.Range("B4:B26"), "Product") 'Operator
    sh3.Range("C" & lR + 2).Value = WorksheetFunction.SumIfs(sh2.Range("G4:G26"), sh2.Range("A4:A26"), "Operator", sh2.Range("B4:B26"), "Product") ' wagons
    sh3.Range("E" & lR + 2).Value = WorksheetFunction.SumIfs(sh2.Range("C4:C26"), sh2.Range("A4:A26"), "Operator", sh2.Range("B4:B26"), "Product") 'ID arrival
    sh3.Range("G" & lR + 2).Value = WorksheetFunction.SumIfs(sh2.Range("M4:M26"), sh2.Range("A4:A26"), "Operator", sh2.Range("B4:B26"), "Product") 'actual arrival time
'With wb2.Sheets("Departures").Activate
'End With

    '!!!! you were referring to sh2 in the lines below. sh2 was set to the 'Arrivals' sheet, not the 'Departure sheet' . It now uses the Departure sheet data
    sh3.Range("H" & lR + 2).Value = WorksheetFunction.SumIfs(sh1.Range("C4:C26"), sh1.Range("A4:A26"), "Operator", sh1.Range("B4:B26"), "Product") 'ID Depature
    sh3.Range("G" & lR + 2).Value = WorksheetFunction.SumIfs(sh1.Range("H4:H26"), sh1.Range("A4:A26"), "Operator", sh1.Range("B4:B26"), "Product") 'actual depart time
        lR = lR + 1
    wb2.Close False

    MyFiles = Dir()
  Loop
 
  Application.ScreenUpdating = True
  Application.DisplayAlerts = True
End Sub

Thanks sijpie.....much appreciated.

one of the issues I still have is adding the date for each returned occurrence and placed in the column "A". The date is in cell "O2" on each of the spreadsheets that will be opened.
Also when the code is run, if there is multiple items that match the sumif criteria it adds them up and returns the total whereas I need it to record each seperate item. I know this to do with the "sumif" but im unsure how else to code it. Sorry, still learning a lot about VBA but really appreciate you input and the explanations.

Bedsy.

sijpie · May 30, 2023

I'll have a look at it later this week

sijpie · Jun 5, 2023

Can you post an example of your Arrivals and Departures sheets? Just to see what will be the best way.

Thanks

bedsy · Jun 5, 2023

sijpie said:
Can you post an example of your Arrivals and Departures sheets? Just to see what will be the best way.

Thanks

HI Sijpie,

Below is the 2 sheets data is pulled from, these are separate sheets in the same workbook. Sheet1 "Arrivals", sheet2 "Departures".

Just to revise, I need to data that matches certain criteria from both the arrivals and departures sheet.

From the "arrivals" I need services that match Operator1 and Product1 to pull the data below;-
Date from Cell "P2", Operator in column "A", ID in column "C", Wagons in column "H" and Actual arrival column "J"

and place in the above "staged" spreadsheet in the following respective columns on the next blank row;-
"P2" in column "A", Operator into column "B", wagons into column "C", Wagons into column "E" and actual arrival into column "F"

then from the "departures" I need the same matching criteria to pull the following detail;-
ID in column "C" and Actual Dep time in column "H"

and place in the respective columns;-
ID into column "G" and Actual Dep time into "H".

Note: the data will be pulled from each day over a monthly cycle. arrivals/departures could be on separate dates (i.e. over midnight) but hope adding the date I should be able to pick this up in the outputs. due to this it is important the captured data is pulled in correct sequence. earliest time to latest time.

Forget about changing the time request as I have gone another direction.




ARRIVALS: 0001 hours - 2359 hours															1.05.2023
Operator	Commodity	ID	Facility	Unit	Actual Unit	Tonnage	Wagons	Planned Arr Time	Actual Arr Time	Mins Late	Planned Unload Time	Complete Unload Time	Actual Start Unload Time	Complete Unload Time	Comments




DEPARTURES: 0001 hours - 2359 hours									1.05.2023
Operator	Commodity	ID	Wgns	Planned Unit No	Actual Unit No	Planned Dep Time	Actual Dep Time	Mins Late	Comments

bedsy · Jun 6, 2023

in addition, this is some code I have tried to develop.

it prompts me to open the file and filters the file correctly, but I cannot figure out how to transfer the filtered columns over to the "staged" worksheet.

I Have also tried the autofilter method and get stuck at the same point.....

VBA Code:

Sub FitlerCopyPaste()
Dim sPath As String, MyFiles As String
  Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet
  Dim wb2 As Workbook
  Dim i As Long
 Dim ws1 As Worksheet, ws2 As Worksheet, lRow As Long
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
 
  Set sh1 = ThisWorkbook.Sheets("Staged")
  
  With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Select Folder"
    If .Show <> -1 Then Exit Sub
    sPath = .SelectedItems(1) & "\"
  End With
 
  i = 1
 
  MyFiles = Dir(sPath & "*.xlsx")
Do While MyFiles <> ""
    Set wb2 = Workbooks.Open(sPath & MyFiles)
    Set sh2 = wb2.Sheets("Arrivals")
    With wb2.Sheets("Arrivals").Activate
    End With
    
 

 With sh2
        .Range("A4").AutoFilter Field:=1, Criteria1:="Operator1"
        .Range("A4").AutoFilter Field:=2, Criteria1:="Product1"
 
        .Range("A4").Resize(lRow - 1).SpecialCells(xlCellTypeVisible).Copy Destination:=sh1.Range("B3")
        .Range("H4").Resize(lRow - 1).SpecialCells(xlCellTypeVisible).Copy Destination:=sh1.Range("C3")
        .Range("C4").Resize(lRow - 1).SpecialCells(xlCellTypeVisible).Copy Destination:=sh1.Range("E3")
        .Range("J4").Resize(lRow - 1).SpecialCells(xlCellTypeVisible).Copy Destination:=sh1.Range("F3")
        .Range("A1").AutoFilter
        End With
    Set sh3 = wb2.Sheets("Departures")
    With wb2.Sheets("Departures").Activate
    End With
    With sh3
        .Range("A4").AutoFilter Field:=1, Criteria1:="Operator1"
        .Range("A4").AutoFilter Field:=2, Criteria1:="Product1"
        .Range("G4").Resize(lRow - 1).SpecialCells(xlCellTypeVisible).Copy Destination:=sh1.Range("G3")
        .Range("H4").Resize(lRow - 1).SpecialCells(xlCellTypeVisible).Copy Destination:=sh1.Range("H3")
        .Range("A1").AutoFilter
      End With
     i = i + 1
    wb2.Close False
 MyFiles = Dir()
  Loop
 
  Application.ScreenUpdating = True
  Application.DisplayAlerts = True
End Sub

sijpie · Jun 7, 2023

I am looking at a completely different way to get your result table. I will look at this code to see what you are trying and incorporate that

bedsy · Jun 7, 2023

sijpie said:
I am looking at a completely different way to get your result table. I will look at this code to see what you are trying and incorporate that

Thanks sijpie …….. much appreciated

sijpie · Jun 7, 2023

A few more questions:

Each line in th ooutput is made up of arrival info and departure info. How do i know which departure belongs to which arrival? Is that the wagon(s) code, or the ID? (so is the departure ID the same as the arrival ID for the particular load)?
For your query you start with a operator name and product. How do you want to enter these? Through two input boxes? or through a userform with comboboxes, or another way?
I can also loop through all data and create an output sheet for each Operator/Product combination

Transferring data utilising VBA

bedsy

New Member

Excel Facts

sijpie

Well-known Member

bedsy

New Member

sijpie

Well-known Member

sijpie

Well-known Member

bedsy

New Member

bedsy

New Member

sijpie

Well-known Member

bedsy

New Member

sijpie

Well-known Member

Similar threads

Forum statistics

Share this page

Transferring data utilising VBA

New Member

Excel Facts

Well-known Member

New Member

Well-known Member

Well-known Member

New Member

New Member

Well-known Member

New Member

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock