create a summary sheet based on the criteria from two diifferent sheets

[manojuasc]

dear sirs

I would request for your consideration to my email to fix this long lasting issues which i couldnt fix after trying since last 3 months.

I have two sheets named "wtsbimport"[sheet1] and "DEHAM"[Sheet2]
I need to put this information in 3rd sheet named "Wt. Slab Data IMP"
in the sheet1, i have to consider columns 7 to column 16, pick the values for these columns and put in the summary sheet[ i have attached the sheets for your reference]
In the sheet2, i have some IDs in column AL, starting from 2nd row. these ID needs to be incorporated from the sheet and put in the summary sheet.
there is the column which is referencing to the size[20s,40s], based on which I need to pick up the ID and put in the summary sheet.
but there is no reference of column I , which is most i want to link between

example is attached in the excel sample, which will help you to understand my problem.

Private Sub CommandButton1_Click()
 Const cShRawData As String = "wtsbimport"
 Dim arrRawData
 Const cDestinationCol As Long = 1          '  4 = Destination ( Start/End point ) (D)
 Const cViaDepotCol As Long = 2              '  5 = Via/Depot ( Pickup / drop of empty ) (E)

 Const cShYellowSheet As String = "DEHAM"
 Const cDropLocCol As Long = 1              '  5 = Drop Location (E)
 Const cDropZipCol As Long = 2               '  21 = Return location (U)
 Const cIdCol As Long = 38                  ' 38 = Id (AL)
  Const cIdsize As Long = 9                  ' 38 = Id (AL)

 Dim arrYellowSheet

 Const cShOutPutData As String = "Wt. Slab Data IMP"
 Dim arrOutPut
    
 Dim oDic As Object, sTemp As String
 Dim iRow As Long, iCol As Long, iPtr As Long
On Error Resume Next
 With Worksheets(cShYellowSheet)
    arrYellowSheet = .Range("a1").CurrentRegion
    End With

 Set oDic = CreateObject("scripting.dictionary")
 oDic.comparemode = 1
 For iRow = 2 To UBound(arrYellowSheet)
    sTemp = Trim$(arrYellowSheet(iRow, cIdsize)) & Trim$(arrYellowSheet(iRow, cDropLocCol))
    If Not oDic.exists(sTemp) Then
        oDic.Item(sTemp) = arrYellowSheet(iRow, cIdCol)
    End If
 Next

 With Worksheets(cShRawData)
    arrRawData = .Range("a13").CurrentRegion
    End With

 ReDim arrOutPut(1 To UBound(arrRawData) * 10, 1 To 5)
 For iRow = 13 To UBound(arrRawData)
    sTemp = Trim$(arrRawData(iRow, cDestinationCol)) & Trim(arrRawData(iRow, cViaDepotCol))
    sTemp = oDic.Item(sTemp)
    For iCol = 7 To 16
       ' If iCol <> 12 Then
            iPtr = iPtr + 1
               arrOutPut(iPtr, 1) = VBA.Choose(iCol, , , , , , , Left(Sheets("wtsbimport").Range("G12").Value, 2) & "s", Left(Sheets("wtsbimport").Range("H12").Value, 2) & "s", Left(Sheets("wtsbimport").Range("I12").Value, 2) & "s", Left(Sheets("wtsbimport").Range("J12").Value, 2) & "s", Left(Sheets("wtsbimport").Range("K12").Value, 2) & "s", Left(Sheets("wtsbimport").Range("L12").Value, 2) & "s", Left(Sheets("wtsbimport").Range("M12").Value, 2) & "s", Left(Sheets("wtsbimport").Range("N12").Value, 2) & "s", Left(Sheets("wtsbimport").Range("O12").Value, 2) & "s", Left(Sheets("wtsbimport").Range("P12").Value, 2) & "s")
               arrOutPut(iPtr, 2) = VBA.Choose(iCol, , , , , , , Sheets("wtsbimport").Range("G2").Value, Sheets("wtsbimport").Range("G3").Value, Sheets("wtsbimport").Range("G4").Value, Sheets("wtsbimport").Range("G5").Value, Sheets("wtsbimport").Range("G6").Value, Sheets("wtsbimport").Range("G7").Value, Sheets("wtsbimport").Range("G8").Value, Sheets("wtsbimport").Range("G9").Value, Sheets("wtsbimport").Range("G10").Value, Sheets("wtsbimport").Range("G11").Value)
            arrOutPut(iPtr, 3) = VBA.Choose(iCol, , , , , , , Sheets("wtsbimport").Range("H2").Value, Sheets("wtsbimport").Range("H3").Value, Sheets("wtsbimport").Range("H4").Value, Sheets("wtsbimport").Range("H5").Value, Sheets("wtsbimport").Range("H6").Value, Sheets("wtsbimport").Range("H7").Value, Sheets("wtsbimport").Range("H8").Value, Sheets("wtsbimport").Range("H9").Value, Sheets("wtsbimport").Range("H10").Value, Sheets("wtsbimport").Range("H11").Value)
            arrOutPut(iPtr, 4) = arrRawData(iRow, iCol)
            arrOutPut(iPtr, 5) = sTemp
        'End If
    Next
 Next

 With Worksheets(cShOutPutData)
    .Cells(1, 1).Resize(, 5) = Array("Size", "From", "To", "Amount", "Id")
    .Cells(2, 1).Resize(UBound(arrOutPut), 5) = arrOutPut
    End With
    End Sub

excel2.jpgexcel3.jpgexcel5.jpg

[manojuasc]

dear experts
i beg you guys to help me as i am struggling to close this project becuase of this issue which i am unable to sort out

please i heartfully will be thankful to you if some one can provide me with the solution
regards

[sourabhg98]

Hi,
I can just see the images. I can't promise I can help, but I will certainly help if I can. But for that I need to see your sheet, which doesn't seem to be attached as you said.
Can you please attach them?

[manojuasc]

dear

i am not sure, why i cant attach the excel sheet to the forum, i am trying my best; to attach the same.
it just shows a thin bar and not opening any pop ups

kindly advise if i can request any alternative way to send you the excel sheet

thanks a lot for the reply and appreciate your response.
regards

[manojuasc]

dear all
I m attaching all the information you require to solve my problem
regards