Combine & compare multiple columns with condition difficulty VBA Excel macro

denova

New Member
Joined
Apr 5, 2021
Messages
2
Office Version
  1. 2016
Platform
  1. Windows
I'm very new to writing Macros in Excel, and have done a bit of looking around to try and solve my problem, but I haven't found a solution yet that works.

I'm trying to write a Macro to do the following:

From Source A (sheet YYYYMMDD, workbook YYYYMMDD.csv) based on Tank_ID values (in 2 columns Source_ID & Destination_ID) I need to combine some columns to get tank activities as:

SOURCE_ID / DESTINATION_ID @ GRADE_ID / MOVE_DENSITY / MOVE_VOLUME / MOVE_MASS / START_DATETIME / END_DATETIME enter image description here

If there is two or more than tank_id value, it will be stored all with separator = vbCrLf

Specially, in case transfer movement, not only show one row tank_id transfer from source but also show one row tank_id transfer to destination. For example: For example:

  • Source_id: 151TK004 -> destination_id: 151TK006 --> type = transfer
  • Source_id: 151TK004 -> destination_id: 151TK002 --> type = transfer enter image description here
  • Source_id: 152TK003 -> destination_id: FLO_TO_FLOHEADER -> type = normal
  • Source_id: 152TK003 -> destination_id: AGO_TO_GOHDS-> type = normal enter image description here
And then I want to copy this data into Destination B (sheet OMS, workbook Daily_Inventory_2021) under the corresponding column name "MMDDYYYY", for example: enter image description here

Both of column Source_ID & Destination_ID in file YYYYMMDD.csv will be compare & matching with column Tank_ID in file Daily_Inventory_2021.xlsm to copy then paste corresponding data. I have to copy information from it to another workbook with every single related column header daily. If column header is not exist, add new value (same datetime as source file) then paste.

Please help me in this case, I'd be extremely grateful for any help. Many thanks!!!

I have tried this but it not enough:

VBA Code:
Sub column()

Dim LastCol As String, date_in, currDay, currMonth, currYear, DestHeader As String
Dim ws1, ws2, w3, w4 As Worksheet
Dim bookName1, bookName2, bookName3, sheetName1, sheetName2, sheetName3, sheetName4 As String
Dim headerRow1, headerRow2, iCol, iiCol, lastRow As String

date_in = Format(Now, "YYYY/MM/DD")

currDay = Format(Date, "dd")
currMonth = Format(Date, "mm")
currYear = Format(Date, "yyyy")

'DestHeader = currMonth & currDay & currYear



bookName2 = "Daily_Inventory_2021.xlsm" 
sheetName2 = "OMS"
headerRow2 = 8

bookName3 = currYear & currMonth & currDay & ".csv"
sheetName3 = currYear & currMonth & currDay

Application.ScreenUpdating = False

Workbooks.Open Filename:="C:\Daily_Inventory_Report\" & bookName3

Set ws3 = Workbooks(bookName3).Sheets(sheetName3)
With ws3
'Find last row
LastRowItem = .Cells(Rows.Count, 7).End(xlUp).Row

    Dim xResult1, xResult2 As String
    Dim xTankId, yTankId As String
    Dim Separator As String
    Separator = vbCrLf 'vbCrlf

    Dim d As dictionary
    Set d = New dictionary
    
    For i = 2 To LastRowItem
        xTankId = .Cells(i, 7).Value
        xResult1 = .Cells(i, 7).Value & " / " & .Cells(i, 8).Value & " @ " & .Cells(i, 9).Value & " / " & .Cells(i, 12).Value & " / " & .Cells(i, 10).Value & " / " & .Cells(i, 11).Value & " / " & .Cells(i, 5).Value & " / " & .Cells(i, 6).Value
        
        If d.Exists(xTankId) Then
         xResult1 = d(xTankId) & Separator & xResult1
         d(xTankId) = xResult1
        Else
         d(xTankId) = xResult1
        End If
    Next
    
For i = 2 To LastRowItem
        xTankId = .Cells(i, 7).Value
        If d.Exists(xTankId) Then
            .Cells(i, 15).Value = d(xTankId)
        End If
    Next i
End With

'Open the workbooks
Workbooks.Open Filename:="C:\Daily_Inventory_Report\" & bookName2

Set ws2 = Workbooks(bookName2).Sheets(sheetName2)

With ws2

LastCol = .Cells(8, .Columns.Count).End(xlToLeft).column
.Cells(8, LastCol + 1) = date_in

End With

With ws2
'Use variation of step 1 to find the destination column
iiCol = 1
Do Until Format(.Cells(headerRow2, iiCol).Value, "YYYY/MM/DD") = Format(Now, "YYYY/MM/DD")
    iiCol = iiCol + 1
Loop


End With

'Close the books
Application.DisplayAlerts = False  'Disable the popups asking for confirm for saving
Workbooks(bookName3).Close saveChanges:=False
Workbooks(bookName2).Close saveChanges:=True
Application.DisplayAlerts = True

End Sub
 

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.

Forum statistics

Threads
1,214,975
Messages
6,122,538
Members
449,088
Latest member
RandomExceller01

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