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

Alvah_

New Member
Joined
Jan 1, 2022
Messages
2
Office Version
  1. 365
Platform
  1. Windows
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)FFWatt marking
19BM6M743534549.2410.4140.959.92406.5679.3405

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

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.
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
VBA 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
 
Upvote 0
Solution
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
VBA 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
 
Upvote 0
Hi
Sorry for the late reply case of net problems in here.
Please try this code
VBA 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
 
Upvote 0

Forum statistics

Threads
1,223,956
Messages
6,175,612
Members
452,660
Latest member
Zatman

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