Hi, I am fairly new to VBA and trying my luck hard to get things working for me. I have an excel sheet where I am looking to get the data on a new worksheet if value matches.
Column G has different cost centers and blank rows in between. I would like to create something if data can be read starting from the last row on column G of "DATA" tab and once a cost center starting with 30* found then it should copy the data till the next up row have a different cost center number into new worksheets including the blank rows.
For example, if Cell G435 has a cost center "30256" and the next cost center "35684" is at cell G150 then macro should start from the bottom and find the cost center number and once found, it should copy the data from G435 to G151 (even if some rows are blank) to a new worksheet and worksheet should be named as the cell value i.e. cost center.
Once the new worksheet are created, the cost center on starting with 30* should replaced by the full cost center number.
I did copy some code and changed it but it is not reflecting the result what I want to see. Below is my code.
Sub createSheets()
Dim lr As Long
Dim ws As Worksheet
Dim i As Integer
Dim ar As Variant
Dim j As Long
Dim rng As Range
Application.ScreenUpdating = False
Set ws = Sheet1 'Sheets code name
lr = ws.Range("G" & Rows.Count).End(xlUp).row
Set rng = ws.Range("G1:G" & lr)
j = ws.[A1].CurrentRegion.Columns.Count + 1
rng.AdvancedFilter 2, , ws.Cells(1, j), True
ar = ws.Range(ws.Cells(2, j), ws.Cells(Rows.Count, j).End(xlUp))
For i = 1 To UBound(ar)
rng.AutoFilter 1, ar(i, 1)
If Not Evaluate("=ISREF('" & ar(i, 1) & "'!A1)") Then
Sheets.Add(after:=Sheets(Sheets.Count)).Name = ar(i, 1)
Else
Sheets(ar(i, 1)).Move after:=Sheets(Sheets.Count)
End If
ws.Range("A1:A" & lr).Resize(, j - 1).Copy [A1]
Next
ws.AutoFilterMode = False
End Sub
I haven't added the last part to change the cost center number in different worksheet yet.
Any help is appreciated. Thanks in advance
Column G has different cost centers and blank rows in between. I would like to create something if data can be read starting from the last row on column G of "DATA" tab and once a cost center starting with 30* found then it should copy the data till the next up row have a different cost center number into new worksheets including the blank rows.
For example, if Cell G435 has a cost center "30256" and the next cost center "35684" is at cell G150 then macro should start from the bottom and find the cost center number and once found, it should copy the data from G435 to G151 (even if some rows are blank) to a new worksheet and worksheet should be named as the cell value i.e. cost center.
Once the new worksheet are created, the cost center on starting with 30* should replaced by the full cost center number.
I did copy some code and changed it but it is not reflecting the result what I want to see. Below is my code.
Sub createSheets()
Dim lr As Long
Dim ws As Worksheet
Dim i As Integer
Dim ar As Variant
Dim j As Long
Dim rng As Range
Application.ScreenUpdating = False
Set ws = Sheet1 'Sheets code name
lr = ws.Range("G" & Rows.Count).End(xlUp).row
Set rng = ws.Range("G1:G" & lr)
j = ws.[A1].CurrentRegion.Columns.Count + 1
rng.AdvancedFilter 2, , ws.Cells(1, j), True
ar = ws.Range(ws.Cells(2, j), ws.Cells(Rows.Count, j).End(xlUp))
For i = 1 To UBound(ar)
rng.AutoFilter 1, ar(i, 1)
If Not Evaluate("=ISREF('" & ar(i, 1) & "'!A1)") Then
Sheets.Add(after:=Sheets(Sheets.Count)).Name = ar(i, 1)
Else
Sheets(ar(i, 1)).Move after:=Sheets(Sheets.Count)
End If
ws.Range("A1:A" & lr).Resize(, j - 1).Copy [A1]
Next
ws.AutoFilterMode = False
End Sub
I haven't added the last part to change the cost center number in different worksheet yet.
Any help is appreciated. Thanks in advance