Macro to cycle and copy to another sheet data

michellin

Board Regular
Joined
Oct 4, 2011
Messages
56
Office Version
  1. 2019
Platform
  1. Windows
Hy there,

I'm really not good to cycle into the sheet to extract value.

I got sheet1 with a table from B4:L53, i need a macro to go down Column B until blank (sometimes i got 20 entry, sometimes 30 or 40 in that b column. That is why i need the cycle option.
If the macro find a value of 6 digit number in the B column (between range 4 at 53), the macro need to create and copy on another sheet (copy all the value on that sheet1, to the new one) from b4.
Here the column he need to copy B, C, L, of each row to the new sheet.

So if in B4 we got a value (ex : 680456), copy B4 ,C4 ,L4 on another sheet after the macro create the new sheet2, like B4 in (B4), C4 in (C4), L4 in (D4). Then if he find on b5 copy on the same sheet2 we copy B4, C4, L4, like this B5 in (B5), C5 in(C5), L5 in (D5) till the last row with value.

The value the macro will search in column b will always be a 6 digit number 680987, 690654, etc.

Column C and L need to copy the value not the function vlookup in it.

I hope i'm clear

thanks in advance and if you know a course online free for cycling macro i will try to learn it

Michellin
 

Attachments

  • Capture.JPG
    Capture.JPG
    75 KB · Views: 4

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"
Kindly give a shot @michellin ,

Set ws = Sheets("sheet2") '-Change your datasheet name

VBA Code:
Option Explicit
Sub test()
Dim ws As Worksheet
Set ws = Sheets("sheet2") '-Change your data sheet name
Dim a As Variant, b As Variant
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
dict.Comparemode = vbTextCompare
Dim i%, k%

'Record the sheet into Dictionary to check if the Result (sheet) is exist
For i = 1 To Worksheets.Count
    dict.Add Sheets(i).Name, ""
Next i

a = ws.Range("b4:l" & ws.Cells(Rows.Count, "b").End(xlUp).Row).Value
ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2))

For i = 1 To UBound(a, 1)
    If Len(a(i, 1)) = 6 Then 'if text length = 6
            k = k + 1
            b(k, 1) = a(i, 1)
            b(k, 2) = a(i, 2)
            b(k, 11) = a(i, 11)
    End If
Next i

If dict.exists("Result") Then
    Sheets("Result").Range("a:l").Clearcontents 'If result already have, then just delete the values
Else
    Sheets.Add(after:=Sheets(Sheets.Count)).Name = "Result" 'if not , create a sheet name "result"
End If

With Sheets("result")
.[b1] = "CODE"
.[c1] = "Description"
.[L1] = "QTY TO ORDER"
.[b2].Resize(UBound(b, 1), UBound(b, 2)).Value = b
End With

End Sub
 
Upvote 0
Solution
Kindly give a shot @michellin ,

Set ws = Sheets("sheet2") '-Change your datasheet name

VBA Code:
Option Explicit
Sub test()
Dim ws As Worksheet
Set ws = Sheets("sheet2") '-Change your data sheet name
Dim a As Variant, b As Variant
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
dict.Comparemode = vbTextCompare
Dim i%, k%

'Record the sheet into Dictionary to check if the Result (sheet) is exist
For i = 1 To Worksheets.Count
    dict.Add Sheets(i).Name, ""
Next i

a = ws.Range("b4:l" & ws.Cells(Rows.Count, "b").End(xlUp).Row).Value
ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2))

For i = 1 To UBound(a, 1)
    If Len(a(i, 1)) = 6 Then 'if text length = 6
            k = k + 1
            b(k, 1) = a(i, 1)
            b(k, 2) = a(i, 2)
            b(k, 11) = a(i, 11)
    End If
Next i

If dict.exists("Result") Then
    Sheets("Result").Range("a:l").Clearcontents 'If result already have, then just delete the values
Else
    Sheets.Add(after:=Sheets(Sheets.Count)).Name = "Result" 'if not , create a sheet name "result"
End If

With Sheets("result")
.[b1] = "CODE"
.[c1] = "Description"
.[L1] = "QTY TO ORDER"
.[b2].Resize(UBound(b, 1), UBound(b, 2)).Value = b
End With

End Sub
OMG RudRud,

Your are so quick !! And it work perfectly, i change my value in it and it rocking. Now i will finish the part i know, how to adjust the celle automaticly etc etc. the easy part... First time i see ubound, i will try to learn about it. I like to get better in vba.
Thanks a lot :)
Michellin
 
Upvote 0
OMG RudRud,

Your are so quick !! And it work perfectly, i change my value in it and it rocking. Now i will finish the part i know, how to adjust the celle automaticly etc etc. the easy part... First time i see ubound, i will try to learn about it. I like to get better in vba.
Thanks a lot :)
Michellin
Glad to assist, If you have any further questions, please don't hesitate to ask/share with us :)

You can prior learn using Array & Dictionary (these two for me are key parts) , keep practicing and you will get the outcomes :)
 
Upvote 0

Forum statistics

Threads
1,215,111
Messages
6,123,155
Members
449,098
Latest member
Doanvanhieu

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