Code to search job id from multiple sources and update main spreadsheet.

K

kevins1218

New Member
Joined
Jun 7, 2024
Messages
6
Office Version
  1. 365
Platform
  1. Windows
First time poster. Please bear with my ignorance of VBA. Also sorry for the long post. I have tried to come up with something and I am getting stuck on the searching part. I did write some code but I'm only at the beginning stage where I can open the workbook and pull data. Please help!

I need to do the following:
1> Pull data from multiple (2 in this case could be more) workbooks - these workbooks have information but not in the same order as the main sheet
1b> Open the source workbook (source1)
2> Search the main sheet to see if the job id exists
2a> If the job id exists, update the values in the row
3> If the job id does not exist, then create a new job row at the bottom and input data from the source
4> Close the workbook (source1)
5> Open the source workbook (source2)
6> Search the main sheet to see if the job id exists
6b> If the job id exists, update the values in the row
7> If the job id does not exits, then create a new job row at the bottom and input data from the source
8> Close the workbook (source2)
9> Sort the main sheet by date submitted column from earliest to oldest.

The following is the code I have so far:

Sub ImportDataFromSource()
Dim wb As Workbook
Dim wb2 As Workbook
Dim nameandpathsource1 As Variant
Dim nameandpathsource2 As Variant

Dim ws1 As Worksheet, ws2 As Worksheet
Dim ws3 As Worksheet, ws4 As Worksheet
Dim lastRow1 As Long, lastRow2 As Long
Dim idCol1 As Range, idCol2 As Range
Dim searchID As Variant, foundCell As Range
Dim rf


Application.DisplayAlerts = False

'selecting what the source1 file is (source1)
nameandpathsource1 = Application.GetOpenFilename(FileFilter:="Excel Files (*.XLSX), *.XLSX", Title:="Select File To Be Opened as Source1")
If nameandpathsource1 = False Then Exit Sub

'1st source
Workbooks.Open Filename:=nameandpathsource1
Set wb = Workbooks.Open(nameandpathsource1)

'add's a new sheet to the main page and name this sheet as source 1
Sheets.Add
ActiveSheet.Name = "Source1"
wb.Sheets("Sheet1").Range("A1:K16").Copy '<--NEED A METHOD TO COPY ALL DATA FROM THE SHEET, COULD BE MORE THAN THIS RANGE!
ThisWorkbook.Sheets("Source1").Range("A1").PasteSpecial xlAll

'close source1
wb.Close False

'make main page the active sheet.
Worksheets("Main").Activate


'Search each id on show page and add in data or create a new entry - HAVING ISSUES FROM HERE ON!
' Set references to the worksheets
Set ws1 = ThisWorkbook.Sheets("Source1")
Set ws2 = ThisWorkbook.Sheets("Main")

' Assuming your IDs are in column A
lastRow1 = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row
lastRow2 = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row

' Assuming your IDs start from row 2
Set idCol1 = ws1.Range("A2:A" & lastRow1)
Set idCol2 = ws2.Range("A2:A" & lastRow2)

' Loop through each ID in Source1
For Each searchID In idCol1
' Search for the ID in Main
Set foundCell = idCol2.Find(searchID.Value, LookIn:=xlValues)

If Not foundCell Is Nothing Then

' ID exists in Sheet2, update values in Main - THIS IS WHERE MY BRAIN TURNED OFF!




Else
' ID doesn't exist in Sheet2, create a new row in Sheet2 - ALSO THIS IS MESSED UP!
lastRow2 = lastRow2 + 1
ws2.Cells(lastRow2, 1).Resize(1, 4).Value = searchID.Offset(0, -1).Resize(1, 4).Value
ws2.Cells(lastRow2, 2).Value = searchID.Value
End If
Next searchID

Worksheets("Source1").Delete






'selecting what the source file is (source2)
nameandpathsource2 = Application.GetOpenFilename(FileFilter:="Excel Files (*.XLSX), *.XLSX", Title:="Select File To Be Opened as Source2")
If nameandpathsource2 = False Then Exit Sub


'2nd source
Workbooks.Open Filename:=nameandpathsource2
Set wb2 = Workbooks.Open(nameandpathsource2)


'name this sheet as source2
Sheets.Add
ActiveSheet.Name = "Source2"
ThisWorkbook.Sheets("Source2").Range("A2").PasteSpecial xlAll

'close source2
wb2.Close False

'Search each id on show page and add in data or create a new entry

' Set references to the worksheets
Set ws3 = ThisWorkbook.Sheets("Source2")
Set ws4 = ThisWorkbook.Sheets("Main")

' Assuming your IDs are in column A
lastRow1 = ws3.Cells(ws1.Rows.Count, "A").End(xlUp).Row
lastRow2 = ws4.Cells(ws2.Rows.Count, "A").End(xlUp).Row

' Assuming your IDs start from row 2
Set idCol1 = ws3.Range("A2:A" & lastRow1)
Set idCol2 = ws4.Range("A2:A" & lastRow2)

' Loop through each ID in Source1
For Each searchID In idCol1
' Search for the ID in Main
Set foundCell = idCol2.Find(searchID.Value, LookIn:=xlValues)

If Not foundCell Is Nothing Then

' ID exists in Sheet2, update values in Main - THIS IS WHERE MY BRAIN TURNED OFF!




Else
' ID doesn't exist in Sheet2, create a new row in Sheet2 - ALSO THIS IS MESSED UP!
lastRow2 = lastRow2 + 1
ws4.Cells(lastRow2, 1).Resize(1, 4).Value = searchID.Offset(0, -1).Resize(1, 4).Value
ws4.Cells(lastRow2, 2).Value = searchID.Value
End If
Next searchID

Worksheets("Source2").Delete

Application.DisplayAlerts = True

End Sub
 

Attachments

  • main sheet.jpg
    main sheet.jpg
    154.2 KB · Views: 7
  • source1 sheet.jpg
    source1 sheet.jpg
    142.5 KB · Views: 7
  • source2 sheet.jpg
    source2 sheet.jpg
    125.6 KB · Views: 7

Excel Facts

Can you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"
Sort by date Sort by votes
It is hard to work with pictures. It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach screenshots (not pictures) of your Main sheet and one of the source sheets. Alternately, you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the 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).
 
Upvote 0
mumps said:
It is hard to work with pictures. It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach screenshots (not pictures) of your Main sheet and one of the source sheets. Alternately, you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the 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).
Click to expand...
Good afternoon.

Thank you for responding. I have attached the link to my google drive for access to the files. The way my office is set up, I can't download and install any programs so instead of going through that maze to get approvals, I have sent link to the workbooks.

Temp Folder - Google Drive

drive.google.com drive.google.com

So from the source files, I need to check on the main workbook if a job id exists. If the job id exists, I need to check all the cells in that row of the source sheets to see if there are any variances and if there are different values, to copy over the values from the source sheets to the main sheet.

If the job id doesn't exist in the main sheet, I need to create a new row at the bottom of the main sheet's list and copy over all the information.

The problem is that the source sheets doe not have the columns in the same order as the main sheet.

Also, the preference of priority in updating from the source sheets is usually source 1 is first and then source 2 is next.

Thank you once again for your help.
 
Upvote 0
In your description, you refer to source files and source sheets so I'm a little confused. Do you want to compare data from the 2 source sheets in the Main workbook to the Main worksheet or do you want to compare the data from the 2 source files to the Main worksheet? Please clarify in detail referring to specific cells, rows, columns, sheets and files using a few examples from your data.
 
Upvote 0
mumps said:
In your description, you refer to source files and source sheets so I'm a little confused. Do you want to compare data from the 2 source sheets in the Main workbook to the Main worksheet or do you want to compare the data from the 2 source files to the Main worksheet? Please clarify in detail referring to specific cells, rows, columns, sheets and files using a few examples from your data.
Click to expand...
So sorry about the confusion. I would like to compare the 2 source sheets in the main workbook to the main worksheet. At this point in time, I can do without the opening of new files. I can manually import them.
1> Lookup job id on source1 sheet and compare each cell of the row to that of the corresponding main sheet and see if each cell value is the same. If there are differences, replace the value in the main sheet with that of the source 2 sheet's value. The issue is that the columns are not in the same order as the main sheet.

Example when a job id already exists:
'Data from source1 first

Job2 (Source1 sheet (A3)) -> Find on Main sheet (A3)
Compare Customer (Source1 sheet (B3)) with Main sheet (H3), if same leave alone, if different, update to Source1 sheet's value (B3)
Compare Service Address (Source1 sheet (C3)) with Main sheet (I3), if same leave alone, if different, update to Source1 sheet's value (C3)
Compare Date Submitted (Source1 sheet (D3)) with Main sheet (B3), if same leave alone, if different, update to Source1 sheet's value (D3)
Compare Billing Party (Source1 sheet (E3)) with Main sheet (K3), if same leave alone, if different, update to Source1 sheet's value (E3)
Compare Prelim Est (Source1 sheet (F3)) with Main sheet (E3), if same leave alone, if different, update to Source1 sheet's value (F3)
Compare Approved Est (Source1 sheet (G3)) with Main sheet (F3),if same leave alone, if different, update to Source1 sheet's value (G3)
Compare Change Order (Source1 sheet (H3)) with Main sheet (G3), if same leave alone, if different, update to Source1 sheet's value (H3)
Compare Status (Source1 sheet (I3)) with Main sheet (L3), if same leave alone, if different, update to Source1 sheet's value (I3)
*Loop for all other entries in Source 1 sheet

'Data from source2 second - same as source1 just that the source2 does not have the same data as source1 nor in the same cell location.

Example when a job id does NOT exist:

Job9 (Source1 sheet (A10)) -> Find/look on Main sheet to see if it exists
'does not exist
Create a new row for this job on Main sheet and put in Job Id in (A10)
Copy Source1 sheet (B10) to Main sheet (H10)
Copy Source1 sheet (C10) to Main sheet (I10)
Copy Source1 sheet (D10) to Main sheet (B10)
Copy Source1 sheet (E10) to Main sheet (k10)
Copy source1 sheet (F10) to Main sheet (E10)
Copy source1 sheet (G10) to Main sheet (F10)
Copy source1 sheet (H10) to main sheet (G10)
Copy source1 sheet (I10) to Main sheet (L10)
*Loop for other entries in Source1 sheet

' Data from Source2 - same as Source1, if the id doesn't exist, create a new entry and copy the corresponding columns to the main sheet.

Either way, thank you again.
 
Upvote 0
Try:
VBA Code: 
Sub ImportDataFromSource()
    Application.ScreenUpdating = False
    Dim desWS As Worksheet, ws As Worksheet, lRow As Long, lCol As Long
    Dim job As Range, header As Range, v As Variant, i As Long, ii As Long, x As Long: x = 2
    Set desWS = Sheets("Main")
    For Each ws In Sheets(Array("Source1", "Source2"))
        With ws
            lRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            lCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
            v = .Range("A1", .Range("A" & .Rows.Count).End(xlUp)).Resize(, lCol)
            For i = LBound(v) + 1 To UBound(v)
                Set job = desWS.Range("A:A").Find(v(i, 1), LookIn:=xlValues, lookat:=xlWhole)
                If Not job Is Nothing Then
                    For ii = 2 To lCol
                        Set header = desWS.Rows(1).Find(ws.Cells(1, ii).Value, LookIn:=xlValues, lookat:=xlWhole)
                        If Not header Is Nothing Then
                            With desWS
                                If .Cells(job.Row, header.Column) <> v(i, ii) Then
                                    .Cells(job.Row, header.Column) = v(i, ii)
                                End If
                            End With
                        End If
                    Next ii
                Else
                    lRow = desWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
                    For ii = 2 To lCol
                        Set header = desWS.Rows(1).Find(ws.Cells(1, ii).Value, LookIn:=xlValues, lookat:=xlWhole)
                        If Not header Is Nothing Then
                            desWS.Cells(lRow, header.Column) = v(i, ii)
                        End If
                    Next ii
                    desWS.Cells(lRow, 1) = v(i, 1)
                End If
            Next i
        End With
    Next ws
    Application.ScreenUpdating = True
End Sub
 
Upvote 1
Solution
mumps said:
Try:
VBA Code: 
Sub ImportDataFromSource()
    Application.ScreenUpdating = False
    Dim desWS As Worksheet, ws As Worksheet, lRow As Long, lCol As Long
    Dim job As Range, header As Range, v As Variant, i As Long, ii As Long, x As Long: x = 2
    Set desWS = Sheets("Main")
    For Each ws In Sheets(Array("Source1", "Source2"))
        With ws
            lRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            lCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
            v = .Range("A1", .Range("A" & .Rows.Count).End(xlUp)).Resize(, lCol)
            For i = LBound(v) + 1 To UBound(v)
                Set job = desWS.Range("A:A").Find(v(i, 1), LookIn:=xlValues, lookat:=xlWhole)
                If Not job Is Nothing Then
                    For ii = 2 To lCol
                        Set header = desWS.Rows(1).Find(ws.Cells(1, ii).Value, LookIn:=xlValues, lookat:=xlWhole)
                        If Not header Is Nothing Then
                            With desWS
                                If .Cells(job.Row, header.Column) <> v(i, ii) Then
                                    .Cells(job.Row, header.Column) = v(i, ii)
                                End If
                            End With
                        End If
                    Next ii
                Else
                    lRow = desWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
                    For ii = 2 To lCol
                        Set header = desWS.Rows(1).Find(ws.Cells(1, ii).Value, LookIn:=xlValues, lookat:=xlWhole)
                        If Not header Is Nothing Then
                            desWS.Cells(lRow, header.Column) = v(i, ii)
                        End If
                    Next ii
                    desWS.Cells(lRow, 1) = v(i, 1)
                End If
            Next i
        End With
    Next ws
    Application.ScreenUpdating = True
End Sub
Click to expand...
Worked perfectly!

Thank you!
 
Upvote 0
mumps said:
Try:
VBA Code: 
Sub ImportDataFromSource()
    Application.ScreenUpdating = False
    Dim desWS As Worksheet, ws As Worksheet, lRow As Long, lCol As Long
    Dim job As Range, header As Range, v As Variant, i As Long, ii As Long, x As Long: x = 2
    Set desWS = Sheets("Main")
    For Each ws In Sheets(Array("Source1", "Source2"))
        With ws
            lRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            lCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
            v = .Range("A1", .Range("A" & .Rows.Count).End(xlUp)).Resize(, lCol)
            For i = LBound(v) + 1 To UBound(v)
                Set job = desWS.Range("A:A").Find(v(i, 1), LookIn:=xlValues, lookat:=xlWhole)
                If Not job Is Nothing Then
                    For ii = 2 To lCol
                        Set header = desWS.Rows(1).Find(ws.Cells(1, ii).Value, LookIn:=xlValues, lookat:=xlWhole)
                        If Not header Is Nothing Then
                            With desWS
                                If .Cells(job.Row, header.Column) <> v(i, ii) Then
                                    .Cells(job.Row, header.Column) = v(i, ii)
                                End If
                            End With
                        End If
                    Next ii
                Else
                    lRow = desWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
                    For ii = 2 To lCol
                        Set header = desWS.Rows(1).Find(ws.Cells(1, ii).Value, LookIn:=xlValues, lookat:=xlWhole)
                        If Not header Is Nothing Then
                            desWS.Cells(lRow, header.Column) = v(i, ii)
                        End If
                    Next ii
                    desWS.Cells(lRow, 1) = v(i, 1)
                End If
            Next i
        End With
    Next ws
    Application.ScreenUpdating = True
End Sub
Click to expand...
Your code is perfect! Is there a way to highlight the changes and/or additions to the main page so that I can see visibly what changes occurred?

Thank you so much once again!
 
Upvote 0
Try:
VBA Code: 
Sub ImportDataFromSource()
    Application.ScreenUpdating = False
    Dim desWS As Worksheet, ws As Worksheet, lRow As Long, lCol As Long
    Dim job As Range, header As Range, v As Variant, i As Long, ii As Long, x As Long: x = 2
    Set desWS = Sheets("Main")
    For Each ws In Sheets(Array("Source1", "Source2"))
        With ws
            lRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            lCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
            v = .Range("A1", .Range("A" & .Rows.Count).End(xlUp)).Resize(, lCol)
            For i = LBound(v) + 1 To UBound(v)
                Set job = desWS.Range("A:A").Find(v(i, 1), LookIn:=xlValues, lookat:=xlWhole)
                If Not job Is Nothing Then
                    For ii = 2 To lCol
                        Set header = desWS.Rows(1).Find(ws.Cells(1, ii).Value, LookIn:=xlValues, lookat:=xlWhole)
                        If Not header Is Nothing Then
                            With desWS
                                If .Cells(job.Row, header.Column) <> v(i, ii) Then
                                    .Cells(job.Row, header.Column) = v(i, ii)
                                    .Cells(job.Row, header.Column).Interior.ColorIndex = 6
                                End If
                            End With
                        End If
                    Next ii
                Else
                    lRow = desWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
                    For ii = 2 To lCol
                        Set header = desWS.Rows(1).Find(ws.Cells(1, ii).Value, LookIn:=xlValues, lookat:=xlWhole)
                        If Not header Is Nothing Then
                            desWS.Cells(lRow, header.Column) = v(i, ii)
                            desWS.Cells(lRow, header.Column).Interior.ColorIndex = 6
                        End If
                    Next ii
                    desWS.Cells(lRow, 1) = v(i, 1)
                End If
            Next i
        End With
    Next ws
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
mumps said:
Try:
VBA Code: 
Sub ImportDataFromSource()
    Application.ScreenUpdating = False
    Dim desWS As Worksheet, ws As Worksheet, lRow As Long, lCol As Long
    Dim job As Range, header As Range, v As Variant, i As Long, ii As Long, x As Long: x = 2
    Set desWS = Sheets("Main")
    For Each ws In Sheets(Array("Source1", "Source2"))
        With ws
            lRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            lCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
            v = .Range("A1", .Range("A" & .Rows.Count).End(xlUp)).Resize(, lCol)
            For i = LBound(v) + 1 To UBound(v)
                Set job = desWS.Range("A:A").Find(v(i, 1), LookIn:=xlValues, lookat:=xlWhole)
                If Not job Is Nothing Then
                    For ii = 2 To lCol
                        Set header = desWS.Rows(1).Find(ws.Cells(1, ii).Value, LookIn:=xlValues, lookat:=xlWhole)
                        If Not header Is Nothing Then
                            With desWS
                                If .Cells(job.Row, header.Column) <> v(i, ii) Then
                                    .Cells(job.Row, header.Column) = v(i, ii)
                                    .Cells(job.Row, header.Column).Interior.ColorIndex = 6
                                End If
                            End With
                        End If
                    Next ii
                Else
                    lRow = desWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
                    For ii = 2 To lCol
                        Set header = desWS.Rows(1).Find(ws.Cells(1, ii).Value, LookIn:=xlValues, lookat:=xlWhole)
                        If Not header Is Nothing Then
                            desWS.Cells(lRow, header.Column) = v(i, ii)
                            desWS.Cells(lRow, header.Column).Interior.ColorIndex = 6
                        End If
                    Next ii
                    desWS.Cells(lRow, 1) = v(i, 1)
                End If
            Next i
        End With
    Next ws
    Application.ScreenUpdating = True
End Sub
Click to expand...
Works perfect! Thank you so much!
 
Upvote 0
You must log in or register to reply here.

Similar threads

N
  • Question Question
Finding the differences then copy and paste code to a new sheet
Replies
1
Views
608
myall_blues
myall_blues
P
  • Question Question
Code used for comparison between 2 list.
Replies
3
Views
641
Tupe77
T
Logit
  • Question Question
Search In Other Workbook - Copy/Paste Offset Data To First Workbook - Repeat Process
Replies
7
Views
275
Logit
Logit
S
  • Solved
Tweak Macro that Imports specific table columns from a different workbook to filter a column first
Replies
4
Views
445
sspatriots
S
C
  • Solved
Copy data from multiple sheets into a master sheet - VBA button stuck
Replies
3
Views
153
NdNoviceHlp
NdNoviceHlp

Forum statistics

Threads
1,223,702
Messages
6,173,936
Members
452,539
Latest member
delvey

Share this page

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
Back
Top