Need to extract data from a big range of data using serial number.

[Alvah_]

Hi everyone, I am relatively new to excel and am basically have been assigned this task where I have to 4K+ different serial numbers, as well as data sheets for these serial numbers. For these serial numbers, I have to go through each and every one of them and copy the range of data that these serial numbers have been provided with into a new excel sheet. I have already manually done 1k+ of these but I am exhausted now. Is there any way to extract this data using a code? I am very new to excel functions/VBA. I'll put in some data below.

Serial No.	Voc(V)	Isc(A)	Vpm (V)	Ipm(A)	Pmax(W)	FF	Watt marking
19BM6M7435345	49.24	10.41	40.95	9.92	406.56	79.3	405

and basically i have to extract the VOC ISC and so on onto another sheet where it is just the serial number.

 

[mohadin]

Hi
And welcome
If I do under stand from your explanation
In sheet1 you have serial numbers with the data (the table you provided)
And in sheet2 you have serial numbers need to get the data from sheet1 into sheet2 corresponding serial no
If so
Try this code

Sub test()
    Dim a As Variant
    Dim i As Long
    With CreateObject("scripting.dictionary")
        a = Sheets("sheet2").Cells(1, 1).Resize(Sheets("sheet2").Cells(Rows.Count, 1).End(xlUp).Row)
        For i = 1 To UBound(a)
            .Item(a(i, 1)) = .Item(a(i, 1))
        Next
        a = Sheets("sheet1").Cells(1, 1).Resize(Sheets("sheet1").Cells(Rows.Count, 1).End(xlUp).Row, 8)
        For i = 1 To UBound(a)
            If .exists(a(i, 1)) Then .Item(a(i, 1)) = Array(a(i, 2), a(i, 3), a(i, 4), a(i, 5), a(i, 6), a(i, 7), a(i, 8))
        Next
        Sheets("sheet2").Cells(1, 2).Resize(.Count, 7) = Application.Index(.items, 0, 0)
    End With
End Sub

If not please provide more details

 

[Alvah_]

Hi
And welcome
If I do under stand from your explanation
In sheet1 you have serial numbers with the data (the table you provided)
And in sheet2 you have serial numbers need to get the data from sheet1 into sheet2 corresponding serial no
If so
Try this code

Sub test()
    Dim a As Variant
    Dim i As Long
    With CreateObject("scripting.dictionary")
        a = Sheets("sheet2").Cells(1, 1).Resize(Sheets("sheet2").Cells(Rows.Count, 1).End(xlUp).Row)
        For i = 1 To UBound(a)
            .Item(a(i, 1)) = .Item(a(i, 1))
        Next
        a = Sheets("sheet1").Cells(1, 1).Resize(Sheets("sheet1").Cells(Rows.Count, 1).End(xlUp).Row, 8)
        For i = 1 To UBound(a)
            If .exists(a(i, 1)) Then .Item(a(i, 1)) = Array(a(i, 2), a(i, 3), a(i, 4), a(i, 5), a(i, 6), a(i, 7), a(i, 8))
        Next
        Sheets("sheet2").Cells(1, 2).Resize(.Count, 7) = Application.Index(.items, 0, 0)
    End With
End Sub

If not please provide more details

Hi! Sorry for the late reply, you have my exact problem described, I received an error while trying to run the code, it highlights "Sheets("sheet2").Cells(1, 2).Resize(.Count, 7) = Application.Index(.items, 0, 0)" this line with a run time error "13" type mismatch. Happy new years btw! Thank you so much for your help

 

[mohadin]

Hi
Sorry for the late reply case of net problems in here.
Please try this code

Sub test()
    Dim a As Variant: Dim b As Variant
    Dim w As Variant: Dim i As Long
    a = Sheets("sheet1").Cells(1, 1).Resize(Sheets("sheet1").Cells(Rows.Count, 1).End(xlUp).Row, 7)
    With CreateObject("scripting.dictionary")
        For i = 1 To UBound(a)
            .Item(a(i, 1)) = Array(a(i, 2), a(i, 3), a(i, 4), a(i, 5), a(i, 6), a(i, 7))
        Next
        a = Sheets("sheet2").Cells(2, 1).Resize(Sheets("sheet2").Cells(Rows.Count, 1).End(xlUp).Row - 1)
        ReDim b(1 To UBound(a))
        For i = 1 To UBound(a)
            If .exists(a(i, 1)) Then
                b(i) = .Item(a(i, 1)): w = .Item(a(i, 1))
            Else
                w(0) = "": w(1) = "": w(2) = "": w(3) = "": w(4) = "": w(5) = "":  b(i) = w
            End If
        Next
        Sheets("sheet2").Cells(2, 2).Resize(UBound(a), 6) = Application.Index(b, 0, 0)
    End With
End Sub