[EN] comparision and copy macro

Hi All,

I'm new to VBA macros on Excel and need your help for an important macro that I'm about to do ...

the required macro must do the following :

compare one coulmn in the 1st sheet to another one in the second sheet and with are the same, it will copies all the line to a new sheet... example :

the macro will make a loop to compare sheet1.cellID to 135.Cell ID and they have the same value, the macro will copy the following cells " Subrack No. Slot No. Subsystem No. NodeB ID NodeB name Cell ID Cell name" from 135 sheet and :

"Start Time Period NE Name BSC6900UCell BSC6900UCell cellID DLSPEECH(none)"

from the sheet1 sheet for this cellid value to target format sheet ...

hope its clear for you now ;;;; your fast respose will be highly appreciated !

attached is the workbook in question .

Hi Forum

Welcome you as new membres.

Try with this macro.

Sub CompareAndCopy()
Dim dict As Object
Dim CellId As String
Dim Ws1 As Worksheet
Dim Ws2 As Worksheet
Dim Ws3 As Worksheet
Dim Cel As Range

Application.ScreenUpdating = False

Set dict = CreateObject("Scripting.Dictionary")
Set Ws1 = Sheets("Sheet1")
Set Ws2 = Sheets("135")
Set Ws3 = Sheets("target format")

Ws3.Range("A1").CurrentRegion.Offset(1).ClearContents

For Each Cel In Ws2.Range("H2:H" & Ws2.Cells(Rows.Count, 1).End(xlUp).Row)
  If Not dict.Exists(Cel) Then dict.Add CStr(Cel.Value), Cel.Row
Next Cel

For Each Cel In Ws1.Range("F2:F" & Ws1.Cells(Rows.Count, 1).End(xlUp).Row)
  CellId = CStr(Split(Cel, "=")(1))
    If dict.Exists(CellId) Then
        Ws1.Cells(Cel.Row, "A").Resize(, 7).Copy Ws3.Range("A" & Ws3.Cells(Rows.Count, "A").End(xlUp).Row + 1)
        Ws2.Cells(dict(CellId), "A").Resize(, 7).Copy Ws3.Range("H" & Ws3.Cells(Rows.Count, "H").End(xlUp).Row + 1)
    End If
Next Cel

Ws3.Columns("A:N").AutoFit

Application.ScreenUpdating = False

Set Ws1 = Nothing
Set Ws2 = Nothing
Set Ws2 = Nothing
Set dict = Nothing

End Sub

Have a nice day

Mytå

Hi Mytå,

amazing ! its working exactly as expected !

thanks a million for your support its really appreciated

engkemo

Hi Forum

Hi Engkemo, hope to help again

Don't forget to end the discussion by checking "Solved"

Mytå