In a bit of help with automating an report

JimRon

New Member
Joined
Oct 22, 2020
Messages
7
Office Version
  1. 365
Platform
  1. Windows
  2. Mobile
I am trying to pull data from an pre complied data dump file. Starting with A10 until three blank rows are detected from the user defined source file. The data is in columns A:AU but only need certain data from within different cells. Need to loop thru the source report to pull from until three blank rows are detected from the user defined source file. I think that I am on the right track in getting this done but not 100% sure if it will work as expected. What needs to occur ( I hope) is to have data pulled based on Product value & placed in a specific format for an report. I have included some of the code and welcome any advise on improving it and getting the expected results.

VBA Code:
' Allow the user to define the filename to be opened

Sub Get_Data_From_File()

' Defines the varibles used

Dim FileToOpen As Variant
Dim OpenBook As Workbook

' Pervent Screen Updating

Application.ScreenUpdating = False

' Request the file to open from the user.

FileToOpen = Application.GetOpenFilenmae(Title:="Browse for your file & Import Range", FileFilter:="Excel Files(*.xls*),*xls*")
If FileToOpen <> False Then
  Set OpenBook = Application.Workbooks.Open(FileToOpen)
  OpenBook.Sheets(1).Range("A10:AU") 
 'Not sure if this is needed . . . ThisWorkbook.Workseets("Line 4 Report").Range("A2").PasteSpecial xlPasteValues
' Don't want to change scource file . . . OpenBook.Close False
End If

' Allows Screen updating to occur.

Application.ScreenUpdating = True


End Sub

' pull data starting with A10 until three blank rows are detected from the user defined source file.
' Data is in columns A:AU but only need certain data from different cells
' Source data is in a pre-complied format and needs to have data pulled based on Product value & placed
' in a specific format for line report.

Sub PullData()

' Defines Variables to be used

Dim iRow As Long
Dim ws As Worksheet

Set ws = Worksheets("Line 4 Report")

' Searches for the next blank row for data entry
iRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1

With ws

    If FileToOpen.Cells(iRow, 8).Value = "Product1" Then
        .Cells(iRow, 1).Value = FileToOpen.Cells(iRow, 1).Value
        .Cells(iRow, 2).Value = FileToOpen.Cells(iRow, 2).Value
        .Cells(iRow, 3).Value = FileToOpen.Cells(iRow, 8).Value
        .Cells(iRow, 4).Value = FileToOpen.Cells(iRow, 9).Value
        .Cells(iRow, 5).Value = FileToOpen.Cells(iRow, 4).Value
        .Cells(iRow, 6).Value = FileToOpen.Cells(iRow, 14).Value
        .Cells(iRow, 7).Value = FileToOpen.Cells(iRow, 18).Value
        .Cells(iRow, 8).Value = FileToOpen.Cells(iRow, 20).Value
        .Cells(iRow, 9).Value = FileToOpen.Cells(iRow, 21).Value
        .Cells(iRow, 10).Value = FileToOpen.Cells(iRow, 22).Value
        .Cells(iRow, 11).Value = FileToOpen.Cells(iRow, 23).Value
        .Cells(iRow, 12).Value = FileToOpen.Cells(iRow, 50).Value
        .Cells(iRow, 13).Value = FileToOpen.Cells(iRow, 30).Value
        .Cells(iRow, 14).Value = FileToOpen.Cells(iRow, 28).Value
        .Cells(iRow, 15).Value = FileToOpen.Cells(iRow, 29).Value
        .Cells(iRow, 16).Value = FileToOpen.Cells(iRow, 31).Value
        .Cells(iRow, 17).Value = FileToOpen.Cells(iRow, 32).Value
        .Cells(iRow, 18).Value = FileToOpen.Cells(iRow, 36).Value
        .Cells(iRow, 19).Value = FileToOpen.Cells(iRow, 41).Value
        .Cells(iRow, 20).Value = FileToOpen.Cells(iRow, 19).Value
        .Cells(iRow, 21).Value = FileToOpen.Cells(iRow, 44).Value
        .Cells(iRow, 22).Value = FileToOpen.Cells(iRow, 45).Value
        .Cells(iRow, 23).Value = FileToOpen.Cells(iRow, 47).Value
        .Cells(iRow, 24).Value = FileToOpen.Cells(iRow, 46).Value
        .Cells(iRow, 25).Value = FileToOpen.Cells(iRow, 48).Value
    ElseIf FileToOpen.Cells(iRow, 8).Value = "Product2" Then
        .Cells(iRow, 1).Value = FileToOpen.Cells(iRow, 1).Value
        .Cells(iRow, 2).Value = FileToOpen.Cells(iRow, 2).Value
        .Cells(iRow, 3).Value = FileToOpen.Cells(iRow, 8).Value
        .Cells(iRow, 4).Value = FileToOpen.Cells(iRow, 9).Value
        .Cells(iRow, 5).Value = FileToOpen.Cells(iRow, 4).Value
        .Cells(iRow, 6).Value = FileToOpen.Cells(iRow, 14).Value
        .Cells(iRow, 7).Value = FileToOpen.Cells(iRow, 18).Value
        .Cells(iRow, 8).Value = FileToOpen.Cells(iRow, 20).Value
        .Cells(iRow, 9).Value = FileToOpen.Cells(iRow, 21).Value
        .Cells(iRow, 10).Value = FileToOpen.Cells(iRow, 22).Value
        .Cells(iRow, 11).Value = FileToOpen.Cells(iRow, 23).Value
        .Cells(iRow, 12).Value = FileToOpen.Cells(iRow, 50).Value
        .Cells(iRow, 13).Value = FileToOpen.Cells(iRow, 30).Value
        .Cells(iRow, 14).Value = FileToOpen.Cells(iRow, 28).Value
        .Cells(iRow, 15).Value = FileToOpen.Cells(iRow, 29).Value
        .Cells(iRow, 16).Value = FileToOpen.Cells(iRow, 31).Value
        .Cells(iRow, 17).Value = FileToOpen.Cells(iRow, 32).Value
        .Cells(iRow, 18).Value = FileToOpen.Cells(iRow, 36).Value
        .Cells(iRow, 19).Value = FileToOpen.Cells(iRow, 41).Value
        .Cells(iRow, 20).Value = FileToOpen.Cells(iRow, 19).Value
        .Cells(iRow, 21).Value = FileToOpen.Cells(iRow, 44).Value
        .Cells(iRow, 22).Value = FileToOpen.Cells(iRow, 45).Value
        .Cells(iRow, 23).Value = FileToOpen.Cells(iRow, 47).Value
        .Cells(iRow, 24).Value = FileToOpen.Cells(iRow, 46).Value
        .Cells(iRow, 25).Value = FileToOpen.Cells(iRow, 48).Value
 
 ' . . . continues for a total of eight products
 
    End If
    
            
End With

End Sub
 

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
10,628
It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach a screenshot (not a picture) of your "Line 4 Report" sheet and the also of the source sheet. Alternately, you could upload a copy of your destination file and source file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark each file for 'Sharing' and you will be given a link to each file that you can post here. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data (de-sensitized if necessary).
 

JimRon

New Member
Joined
Oct 22, 2020
Messages
7
Office Version
  1. 365
Platform
  1. Windows
  2. Mobile
Ok. First the source file (This just small amount of the file has it has around 3569 rows of data)
Repair Order - Raw Data Dump.xlsx
ABCDEFGHIJKLMNOPQRSTUVWXYZAAABACADAEAFAGAHAIAJAKALAMANAOAPAQARASATAUAVAWAX
9Repair Order NumberRMA NumberExternal RMA NumberSerial#Reported Serial#Product TypeManufacturerProductProduct Part#Reported Part#Manufacturer Part#Part DescriptionService TypeStatusInspection TypeInspection CodeInspection Group Inspection NameInspection Completed ByDefect LocationDefect NameConsumed Product Part#Consumed Item NameConsumed Item TypeQuantityReturn ReasonDisposition Received DateRepair DateRepair Completed ByShipped DateClosed DateProjectCompanyCustomer NameAirport Location CodeAddressCityStateZipCountryPhoneCompany NameInbound Tracking NumberOutbound Tracking NumberCycle TimeBouncerHold PartsIn-WarrantyRepair Action
10RO2020101800004R2020101800004RITM2146593R00025806N/AKioskElectronics for Imaging, Inc.G5 Card Reader890211N/A45104747Mininet5; MininetM500 StationAdvanced ExchangeAwaiting InspectionN/AN/AN/AN/AN/AN/AN/AN/AN/AN/A0Display problemRepair05/26/2021N/AN/AN/AN/AKioskProduct OfficeTaylerWalkerWTCKN10 UNION SQUARE EAST NEW YORKNew York10003United States of America2123533860Kiosk3979648757503979648752241No00N/A
11RO2020112700157R2020112700156R2020112700156BAH05002N/APrinting Devices, Thermal PrintersToshiba America Business SolutionsAstra 2422040013N/AN/APRINTER; ASTRA 2 (N VERSION BT MODULE) VERSION 2.1 + EDRRepair & Return to CustomerDeliveredN/AN/AN/AN/ARoberto Martinez (OSV)Main HousingDamaged714115Cover Open Switch (with Harness)Part1No RMARepair11/27/202005/25/2021Diosdado Bullen05/25/202105/26/2021GOTS - PrintersProduct ExpressrandypuckettEQUAD2903 SPRANKLE/RANDY PUCKETT MEMPHISTennessee38118United States of America9013605060GOTS - Printers1111111111117875820501570Yes00Replaced
12RO2020112700157R2020112700156R2020112700156BAH05002N/APrinting Devices, Thermal PrintersToshiba America Business SolutionsAstra 2422040013N/AN/APRINTER; ASTRA 2 (N VERSION BT MODULE) VERSION 2.1 + EDRRepair & Return to CustomerDeliveredN/AN/AN/AN/ARoberto Martinez (OSV)Main HousingDamaged714119LCD Unit VLSG0620-01Part1No RMARepair11/27/202005/25/2021Diosdado Bullen05/25/202105/26/2021GOTS - PrintersProduct ExpressrandypuckettEQUAD2903 SPRANKLE/RANDY PUCKETT MEMPHISTennessee38118United States of America9013605060GOTS - Printers1111111111117875820501570Yes00Replaced
13RO2020112700157R2020112700156R2020112700156BAH05002N/APrinting Devices, Thermal PrintersToshiba America Business SolutionsAstra 2422040013N/AN/APRINTER; ASTRA 2 (N VERSION BT MODULE) VERSION 2.1 + EDRRepair & Return to CustomerDeliveredN/AN/AN/AN/ARoberto Martinez (OSV)Main HousingDamaged714881Peel off Sensor CoverPart1No RMARepair11/27/202005/25/2021Diosdado Bullen05/25/202105/26/2021GOTS - PrintersProduct ExpressrandypuckettEQUAD2903 SPRANKLE/RANDY PUCKETT MEMPHISTennessee38118United States of America9013605060GOTS - Printers1111111111117875820501570Yes00Replaced
14RO2021012500166R2021012500185R2021012500185JAB8150171N/AHandheldsZebra TechnologiesWT6000607753N/AWT60A0-TS0LEO1WRIST TERMINAL; WT6000 FXGRepair & Return to CustomerAwaiting PackagingDTDT0013VibratorFunctionalDallas Mize (OSV)MainboardDamaged717268FRU:MAIN BOARD,WT6000Part1OthersRepair05/25/202105/26/2021Dallas Mize (OSV)N/AN/AOT - Operations Technology FXGProduct GroundFDX GRD/GRAND RAPIDSCHARLES VANDERZWAAGN/A3466 SHIPPERS DRIVE NW GRAND RAPIDSMichigan49544United States of America6166471900N/AN/A1No00Replaced
15RO2021012500166R2021012500185R2021012500185JAB8150171N/AHandheldsZebra TechnologiesWT6000607753N/AWT60A0-TS0LEO1WRIST TERMINAL; WT6000 FXGRepair & Return to CustomerAwaiting PackagingVIVI004N/AOuter CasingDallas Mize (OSV)Top HousingDamaged715407SCAN CONNECTOR; WT6Part2OthersRepair05/25/202105/26/2021Dallas Mize (OSV)N/AN/AOT - Operations Technology FXGProduct GroundFDX GRD/GRAND RAPIDSCHARLES VANDERZWAAGN/A3466 SHIPPERS DRIVE NW GRAND RAPIDSMichigan49544United States of America6166471900N/AN/A1No00Replaced
16RO2021020800715R2021020801093RITM241434875851N/ADropbox EquipmentBellatrixIR Lock795433N/A070-0102-16IR LOCK; DROPBOX; LOCK ONLY; (W / BATTS) MFGR #070-0102-17Repair & Return to InventoryClosedN/AN/AN/AN/AMolito Mopal (OSV)N/AN/AN/AN/AN/A0OthersRepair02/11/2021N/AN/AN/A05/26/2021GOTS - DropboxProduct ExpressGaryRedshaw693563100 HANSEN WAY PALO ALTOCalifornia94304United States of America8883398324GOTS - Dropbox118149053425N/A1No00N/A
17RO2021021100574R2021021100747RITM242700971355N/ADropbox EquipmentBellatrixIR Lock795433N/A070-0102-16IR LOCK; DROPBOX; LOCK ONLY; (W / BATTS) MFGR #070-0102-17Repair & Return to InventoryClosedN/AN/AN/AN/AMolito Mopal (OSV)N/AN/AN/AN/AN/A0OthersRepair02/23/2021N/AN/AN/A05/26/2021GOTS - DropboxProduct ExpressGaryRedshaw9579355 ALMADEN BLVD SAN JOSECalifornia95113United States of America8883398324GOTS - Dropbox118149053609N/A1No00N/A
18RO2021021100695R2021021100922RITM2427517VM3W172566080N/AComputer, IndustrialHoneywell InternationalVM3 Thor195900024N/AVM3W2F1A1AUS1EDFLAT PANEL; FXF HONEYWELL VM3 THOR; WIN10ML; 64G INDOOR USARepair & Return to CustomerIn TransitN/AN/AN/AN/AThea XayaphetSoftware/FirmwareSoftware Issue000003Operating SystemPart1Won’t turn on/offRepair05/18/202105/25/2021Andrew Chaney05/25/202105/25/2021OT - Operations TechnologyProduct FreightKevinBairFFBGM175 BUCK RD NICHOLSNew York13812United States of America9516817400OT - Operations TechnologyN/A7875867064531No00Replaced
19RO2021022300415R2021022300523R2021022300523BDA15030N/APrinting Devices, Thermal PrintersToshiba America Business SolutionsAstra 3422040016N/AB-FP3D-GH30-FE-R(AD)Printer; Astra 3 inch; Domestic; B-FP3D-GH32-AD-R-ADRepair & Return to CustomerDeliveredN/AN/AN/AN/ARiean Onorati (OSV)Main HousingDamaged715933Func Unit Assy-FE-FP3D (ROHS)Part1DamagedRepair02/23/202105/21/2021Jacob Resendez (OSV)05/24/202105/26/2021GOTS - PrintersProduct ExpressRYANRUBLESGFA2221 EAST OLIVE COURT SPRINGFIELDMissouri65802United States of America4178688371GOTS - Printers7729220273687875166839451No00Replaced
20RO2021030100381R2021030100584R2021030100584B5G9M53N/AComputers, NotebooksVariousGeneric Notebook506N/AGENERICLAPTOPNOTEBOOK; CORP PC FXS GENERIC FEC #Repair & Return to CustomerDeliveredDTDT0040Power On / Burn InLocks UpJames JarrettMainboardInoperative711627SYSTEM BOARD – LTPart1No RMARepair03/01/202105/25/2021Yaaqob Almurshedi05/25/202105/26/2021Corporate Equipment Repair (CER)Product ServicesMattBindbeutelN/A3650 Hacks Cross Rd Building E 2nd Floor MEMPHISTennessee38125United States of America9014344651Corporate Equipment Repair (CER)4852105768517875868314240No00Replaced
21RO2021030100381R2021030100584R2021030100584B5G9M53N/AComputers, NotebooksVariousGeneric Notebook506N/AGENERICLAPTOPNOTEBOOK; CORP PC FXS GENERIC FEC #Repair & Return to CustomerDeliveredN/AN/AN/AN/AJames JarrettSoftware/FirmwarePreventive Maintenance000003Operating SystemPart1No RMARepair03/01/202105/25/2021Yaaqob Almurshedi05/25/202105/26/2021Corporate Equipment Repair (CER)Product ServicesMattBindbeutelN/A3650 Hacks Cross Rd Building E 2nd Floor MEMPHISTennessee38125United States of America9014344651Corporate Equipment Repair (CER)4852105768517875868314240No00Replaced
22RO2021031500334R2021031500717RITM2514693BDA21551N/APrinting Devices, Thermal PrintersToshiba America Business SolutionsAstra 3422040016N/AB-FP3D-GH30-FE-R(AD)Printer; Astra 3 inch; Domestic; B-FP3D-GH32-AD-R-ADRepair & Return to CustomerIn TransitN/AN/AN/AN/ARiean Onorati (OSV)Main HousingDamaged715933Func Unit Assy-FE-FP3D (ROHS)Part1OthersRepair03/16/202105/25/2021Jacob Resendez (OSV)05/25/202105/26/2021GOTS - PrintersProduct ExpressRICHARDREINHARDTHPNA669 SOUTH THIRD AVENUE MOUNT VERNONNew York10550United States of America9146641704GOTS - Printers1388437470107875869035741No00Replaced
23RO2021031500334R2021031500717RITM2514693BDA21551N/APrinting Devices, Thermal PrintersToshiba America Business SolutionsAstra 3422040016N/AB-FP3D-GH30-FE-R(AD)Printer; Astra 3 inch; Domestic; B-FP3D-GH32-AD-R-ADRepair & Return to CustomerIn TransitN/AN/AN/AN/ARiean Onorati (OSV)Main HousingDamaged715934Paper Cover-MO-FP3D (ROHS)Part1OthersRepair03/16/202105/25/2021Jacob Resendez (OSV)05/25/202105/26/2021GOTS - PrintersProduct ExpressRICHARDREINHARDTHPNA669 SOUTH THIRD AVENUE MOUNT VERNONNew York10550United States of America9146641704GOTS - Printers1388437470107875869035741No00Replaced
24RO2021031800013R2021031800024RITM2524948BAC43484N/APrinting Devices, Thermal PrintersToshiba America Business SolutionsAstra 2422040006N/AB-EP4DL-GH30-QM-RPRINTER; ASTRA 2 PORTABLE LABEL; REPL FOR ASTRAPLUSRepair & Return to CustomerClosedN/AN/AN/AN/AJerod Stone (OSV)N/AN/AN/AN/AN/A0OthersRepair03/19/202104/09/2021Jerod Stone (OSV)N/A05/26/2021GOTS - PrintersProduct ExpressRANDYPUCKETTEQUAH2903 SPRANKLE/RANDY PUCKETT MEMPHISTennessee38118United States of America9017974933GOTS - Printers111Picked Up1No00N/A
25RO2021032500250R2021032500434R2021032500434RGC39F0431N/AHandheldsGetac TechnologyF110-G2939014492N/A52628707008NLAPTOP; GETAC;F110G2/1HAF4/S6S2X2/AXXXFB/S1A11DA2F1/3XXXXXRepair & Return to CustomerClosedN/AN/AN/AN/AKamaljit Kaur (OSV)N/AN/AN/AN/AN/A0POWERRepair03/29/2021N/AN/AN/A05/26/2021External Getac RepairsGetacRobertRowellN/A2975 Sprankle Dr MemphisTennessee38118United States of America9014829025External Getac Repairs785183058790BER1No00N/A
26RO2021032500252R2021032500434R2021032500434RK203F1871N/AHandheldsGetac TechnologyF110-G3939019524N/A5262878301JBTABLET; GETAC;F110G3/1DBF3/S6S6X2/AXXXGB/S1A11DA2F1/3XX000/XRepair & Return to CustomerClosedN/AN/AN/AN/AKamaljit Kaur (OSV)DeviceDamaged581187830007SERVICE PARTS;CASE B KIT W/I DIGI ENHANCED ANTI SHOCK F110G3Part1Physical DamageRepair03/29/202103/31/2021Mandy Williams03/31/202105/26/2021External Getac RepairsGetacRobertRowellN/A2975 Sprankle Dr MemphisTennessee38118United States of America9014829025External Getac Repairs7851830587903227737159036981No00N/A
27RO2021033000481R2021033000739RITM2557888BAC43155N/APrinting Devices, Thermal PrintersToshiba America Business SolutionsAstra 2422040006N/AB-EP4DL-GH30-QM-RPRINTER; ASTRA 2 PORTABLE LABEL; REPL FOR ASTRAPLUSRepair & Return to CustomerIn TransitN/AN/AN/AN/ARiean Onorati (OSV)Main HousingDamagedN/AN/AN/A0DamagedRepair03/31/202105/25/2021Tui Mataele (OSV)05/25/202105/25/2021GOTS - PrintersProduct ExpressRonVan OverbekeOAKH1 SALLY RIDE WAY OAKLANDCalifornia94621United States of America5106393700GOTS - Printers7733035740857875716155441No00N/A
28RO2021033000481R2021033000739RITM2557888BAC43155N/APrinting Devices, Thermal PrintersToshiba America Business SolutionsAstra 2422040006N/AB-EP4DL-GH30-QM-RPRINTER; ASTRA 2 PORTABLE LABEL; REPL FOR ASTRAPLUSRepair & Return to CustomerIn TransitN/AN/AN/AN/ARiean Onorati (OSV)Right HousingDamagedN/AN/AN/A0DamagedRepair03/31/202105/25/2021Tui Mataele (OSV)05/25/202105/25/2021GOTS - PrintersProduct ExpressRonVan OverbekeOAKH1 SALLY RIDE WAY OAKLANDCalifornia94621United States of America5106393700GOTS - Printers7733035740857875716155441No00N/A
29RO2021040500028R2021040500029R2021040500029BDA07602N/APrinting Devices, Thermal PrintersToshiba America Business SolutionsAstra 3422040016N/AB-FP3D-GH30-FE-R(AD)Printer; Astra 3 inch; Domestic; B-FP3D-GH32-AD-R-ADRepair & Return to CustomerDeliveredN/AN/AN/AN/AJacob Resendez (OSV)Main HousingDamaged715933Func Unit Assy-FE-FP3D (ROHS)Part1N/ARepair04/05/202105/25/2021Jacob Resendez (OSV)05/25/202105/26/2021GOTS - PrintersProduct ExpressNICHOLASROROSISPA140 COMAC STREET RONKONKOMANew York11779United States of America6315804900GOTS - Printers7855249984487875868958151No00Replaced
30RO2021040500257R2021040500372RITM25771968FKSA93800N/AHandheldsPanasonic Corporation of North AmericaFZ-N1195901021N/AFZ-N1CCCAP8M1Handheld; PNA FZ-N1 Black Bezel; FXF DockRepair & Return to CustomerShipVIVI015N/AConsumables (straps, screen protectors, stylus, etc.)Daryl McKinneyLCD AssemblyDamagedDHHX1647ZBK81 - PROTECTIVE FILM (INTERNAL)Part1Scanner/camera problemRepair05/26/202105/26/2021Daryl McKinney05/26/2021N/AExternal Panasonic RepairsPanasonicJeffreyTierney2300 S Mount Prospect Rd Des Plaines2300 S Mount Prospect Rd Des PlainesIllinois60018United States of America8478279815N/AN/A7876125617611Yes00Replaced
31RO2021052600167R2021040801315RITM2591955-8EKSA88016N/AN/AFZ-N1FZ-N1CCCAP8M1N/AN/AFZ-N1Repair & Return to InventoryScrap VendorN/AN/AN/AN/ASharon ChoateN/AN/AN/AN/AN/A0N/ARepair05/26/2021N/AN/AN/AN/AOT - Dock / Dock SupervisorProduct FreightEddieCollinsMEMPG555 COMPRESS DRIVE MEMPHISTennessee38106United States of America0000000000N/AN/AN/A0No00N/A
32RO2021040800948R2021040801315RITM25919558EKSA88016N/AHandheldsPanasonic Corporation of North AmericaFZ-N1195901021N/AFZ-N1CCCAP8M1Handheld; PNA FZ-N1 Black Bezel; FXF DockRepair & Return to CustomerShipN/AN/AN/AN/ASharon ChoateDeviceDamagedFZ-N1CCCAP8M1FZ-N1Part1DamagedRepair05/21/202105/26/2021Sharon Choate05/26/2021N/AOT - Dock / Dock SupervisorProduct FreightEddieCollinsMEMPG555 COMPRESS DRIVE MEMPHISTennessee38106United States of America0000000000N/AN/A7876114181991No00Replaced
33RO2021040900077R2021040900078RITM2563704JAC6260701N/AHandheldsZebra TechnologiesRS6000607754N/ARS60B0-SRSF01RING SCANNER; RS6000 FXGRepair & Return to CustomerAwaiting PackagingDTDT0021CommunicationBluetoothRichard GreeneMainboardDamaged715582Chassis, RS6Part1DamagedRepair05/25/202105/26/2021Richard GreeneN/AN/AOT - Operations Technology FXGProduct GroundAnthonyDeSantisDENVG8951 YOSEMITE STREET HendersonColorado80640United States of America0000000000N/A773324684812N/A1Yes00Replaced
34RO2021040900077R2021040900078RITM2563704JAC6260701N/AHandheldsZebra TechnologiesRS6000607754N/ARS60B0-SRSF01RING SCANNER; RS6000 FXGRepair & Return to CustomerAwaiting PackagingVIVI004N/AOuter CasingRichard GreeneBottom HousingDamaged715760Comfort Pad (Trigger Two Hole) (retrofit part)Part1DamagedRepair05/25/202105/26/2021Richard GreeneN/AN/AOT - Operations Technology FXGProduct GroundAnthonyDeSantisDENVG8951 YOSEMITE STREET HendersonColorado80640United States of America0000000000N/A773324684812N/A1Yes00Replaced
35RO2021040900077R2021040900078RITM2563704JAC6260701N/AHandheldsZebra TechnologiesRS6000607754N/ARS60B0-SRSF01RING SCANNER; RS6000 FXGRepair & Return to CustomerAwaiting PackagingVIVI004N/AOuter CasingRichard GreeneMain HousingDamaged715414Light Pipe, RS6Part1DamagedRepair05/25/202105/26/2021Richard GreeneN/AN/AOT - Operations Technology FXGProduct GroundAnthonyDeSantisDENVG8951 YOSEMITE STREET HendersonColorado80640United States of America0000000000N/A773324684812N/A1Yes00Replaced
36RO2021040900077R2021040900078RITM2563704JAC6260701N/AHandheldsZebra TechnologiesRS6000607754N/ARS60B0-SRSF01RING SCANNER; RS6000 FXGRepair & Return to CustomerAwaiting PackagingVIVI004N/AOuter CasingRichard GreeneMain HousingMissing715430Main seal, RS6Part1DamagedRepair05/25/202105/26/2021Richard GreeneN/AN/AOT - Operations Technology FXGProduct GroundAnthonyDeSantisDENVG8951 YOSEMITE STREET HendersonColorado80640United States of America0000000000N/A773324684812N/A1Yes00Replaced
37RO2021040900077R2021040900078RITM2563704JAC6260701N/AHandheldsZebra TechnologiesRS6000607754N/ARS60B0-SRSF01RING SCANNER; RS6000 FXGRepair & Return to CustomerAwaiting PackagingVIVI004N/AOuter CasingRichard GreeneMain HousingMissing715579Light Pipe Seal, RS6Part1DamagedRepair05/25/202105/26/2021Richard GreeneN/AN/AOT - Operations Technology FXGProduct GroundAnthonyDeSantisDENVG8951 YOSEMITE STREET HendersonColorado80640United States of America0000000000N/A773324684812N/A1Yes00Replaced
38RO2021040900077R2021040900078RITM2563704JAC6260701N/AHandheldsZebra TechnologiesRS6000607754N/ARS60B0-SRSF01RING SCANNER; RS6000 FXGRepair & Return to CustomerAwaiting PackagingVIVI015N/AConsumables (straps, screen protectors, stylus, etc.)Richard GreeneConsumablesNon-Reusable Part715764Lightpipe Screws, RS6000Part4DamagedRepair05/25/202105/26/2021Richard GreeneN/AN/AOT - Operations Technology FXGProduct GroundAnthonyDeSantisDENVG8951 YOSEMITE STREET HendersonColorado80640United States of America0000000000N/A773324684812N/A1Yes00Replaced
Repair Order Raw Data
 

JimRon

New Member
Joined
Oct 22, 2020
Messages
7
Office Version
  1. 365
Platform
  1. Windows
  2. Mobile
and the report sheet
Repair Order NumberRMA NumberProductProduct Part#Serial#StatusInspection NameDefect LocationDefect NameConsumed FedEx Part#Consumed Item NameRepair ActionRepair Completed ByReceived DateRepair DateShipped DateClosed DateAirport Location CodeCountryInspection Completed ByInbound Tracking NumberOutbound Tracking NumberBouncerCycle TimeHold Parts
 

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
10,628

ADVERTISEMENT

According to this line of code in your macro:
Rich (BB code):
If FileToOpen.Cells(iRow, 8).Value = "Product1" Then
you are looking for the text "Product1" in column H of the source file and you want to "continue for a total of eight products". Looking at your data in Post #3, I don't see the text "Product1" anywhere in column H. Please clarify in detail what the actual eight products are that you want to search. You define "iRow" based on the "Line 4 Report" sheet but then use the variable in the source sheet as seen in red above. Please clarify.
Starting with A10 until three blank rows are detected from the user defined source file.
The only place that 3 blank rows exist in the source file you posted, is at the bottom of the sheet. Are you saying that you could have 1 or more blank rows anywhere in the source sheet and that you want to set 3 consecutive blank rows if they exist, as the bottom of the range you want to copy? Also, although your data starts at row 2, you want to start the copy at row 10. Is this correct?
 

JimRon

New Member
Joined
Oct 22, 2020
Messages
7
Office Version
  1. 365
Platform
  1. Windows
  2. Mobile
The product list in column H of the source sheet. As the sheet is created automatedly based on scanned tickets there should not be blank rows in the source sheet however, with dealing with the human side of the scanners, I assume that a line might be missed by mistake. the full report contains details about who and when the data dump is pulled so in complied data starts in 10 and contain up 9 thousand rows of data. "product1" is considered a place holder for a given product to be pulled, i.e. printer, computer, scanner, radio, or Bluetooth device.
 

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
10,628

ADVERTISEMENT

Try:
VBA Code:
Sub Get_Data_From_File()
    Application.ScreenUpdating = False
    Dim flder As FileDialog, FileName As String, FileChosen As Integer, wkbSource As Workbook, wkbDest As Workbook, wsDest As Worksheet
    Dim i As Long, x As Long, v1 As Variant, LastRow As Long, Header As Range, rng As Range
    Set wkbDest = ThisWorkbook
    Set wsDest = wkbDest.Sheets("Line 4 Report")
    Set flder = Application.FileDialog(msoFileDialogFilePicker)
    flder.Title = "Browse for your file & Import Range"
    flder.Filters.Add "Excel Macros Files", "*.xlsx"
    FileChosen = flder.Show
    FileName = flder.SelectedItems(1)
    Set wkbSource = Workbooks.Open(FileName)
    v1 = wkbSource.Sheets(1).Range("H10", wkbSource.Sheets(1).Range("H" & Rows.Count).End(xlUp)).Value
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(v1, 1)
            If Not .Exists(v1(i, 1)) Then
                .Add v1(i, 1), Nothing
                With wkbSource.Sheets(1)
                    LastRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                    .Range("A1:AX" & LastRow).AutoFilter Field:=8, Criteria1:=v1(i, 1)
                    For Each rng In wsDest.Range("A1", wsDest.Range("A1").End(xlToRight))
                        Set Header = .Rows(1).Find(rng, LookIn:=xlValues, lookat:=xlWhole)
                        If Not Header Is Nothing Then
                            wsDest.Cells(wsDest.Rows.Count, rng.Column).End(xlUp).Offset(1).Resize(.[subtotal(103,A:A)] - 1).Value = Intersect(.AutoFilter.Range.Offset(9), .Columns(Header.Column)).Value
                        End If
                    Next rng
                End With
            End If
        Next i
    End With
    wkbSource.Close False
    Application.ScreenUpdating = True
End Sub
 

JimRon

New Member
Joined
Oct 22, 2020
Messages
7
Office Version
  1. 365
Platform
  1. Windows
  2. Mobile
This code is a lot different than what I started with. Not sure if I follow it correctly. Please explain how does it get from the user the file to open, how it pulls from only from the rows with the requested data (From Columns H, A,B, . . . . .,and advances to the next row of data.
 

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
10,628
Here is the macro with explanatory notes. I hope this helps.
VBA Code:
Sub Get_Data_From_File()
    Application.ScreenUpdating = False
    Dim flder As FileDialog, FileName As String, FileChosen As Integer, wkbSource As Workbook, wkbDest As Workbook, wsDest As Worksheet
    Dim i As Long, x As Long, v1 As Variant, LastRow As Long, Header As Range, rng As Range
    Set wkbDest = ThisWorkbook
    Set wsDest = wkbDest.Sheets("Line 4 Report")
    Set flder = Application.FileDialog(msoFileDialogFilePicker) 'opens window to select the file
    flder.Title = "Browse for your file & Import Range"
    flder.Filters.Add "Excel Macros Files", "*.xlsx"
    FileChosen = flder.Show
    FileName = flder.SelectedItems(1)
    Set wkbSource = Workbooks.Open(FileName)
    v1 = wkbSource.Sheets(1).Range("H10", wkbSource.Sheets(1).Range("H" & Rows.Count).End(xlUp)).Value 'places values in column H into an array
    With CreateObject("Scripting.Dictionary") 'creates a dicitonary to store the unique values in column H
        For i = 1 To UBound(v1, 1) 'loops through the array values
            If Not .Exists(v1(i, 1)) Then 'checks to see if the value in column H, exists in the dicitonary
                .Add v1(i, 1), Nothing 'if ti doesn't exist, it is added to the dicitonary
                With wkbSource.Sheets(1)
                    LastRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                    .Range("A1:AX" & LastRow).AutoFilter Field:=8, Criteria1:=v1(i, 1) 'autofilters sheet1 in the source file on the unique value from column H
                    For Each rng In wsDest.Range("A1", wsDest.Range("A1").End(xlToRight)) 'loops through the headers in row 1 of the destination sheet
                        Set Header = .Rows(1).Find(rng, LookIn:=xlValues, lookat:=xlWhole) 'searches for the header in the source sheet
                        If Not Header Is Nothing Then 'when the header is found, the next line of code copies the filtered range in the found column starting at row 10 to the corresponding column in the destination sheet
                            wsDest.Cells(wsDest.Rows.Count, rng.Column).End(xlUp).Offset(1).Resize(.[subtotal(103,A:A)] - 1).Value = Intersect(.AutoFilter.Range.Offset(9), .Columns(Header.Column)).Value
                        End If
                    Next rng 'searched for the next header
                End With
            End If
        Next i 'goes to next value in the array
    End With
    wkbSource.Close False
    Application.ScreenUpdating = True
End Sub
 

Forum statistics

Threads
1,144,628
Messages
5,725,376
Members
422,621
Latest member
dfrare

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top