Detect a pattern and copy and edit rows using VBA script

Hi everyone,

I have a spreadsheet containing data in columns A to AH. column A contains a series of codes that are repeated. For example:

K123LS
K123LS
K123LS
K123LS
K124LL
K124LL
K264LL
K264LL
K264LL
K264LL
K264LL
K315LS
K315LS
K315LS
K315LS

I need to do the following:

Have the VBA code detect a series of alpha-numeric values, ie. the values in column A that are repeated down a set of consecutive rows
When it finds the pattern it should copy the first row in the series and insert it above that series. In the above example, it would copy 4 rows since there are 4 unique values.
In that copied row, it should then delete the information found in columns B, C, D, E, F, G and H
After the deletion in the copied row, it should then Insert the word "configurable" (without the inverted commas) into column B
After the above steps have been completed on the entire spreadsheet, the code should then look for any rows where column B has a value of "simple" (without the inverted commas). For any of those simple rows, it should delete the information found in columns I to AH, that is from column I right to the end of the columns.

I wondered if someone could help me with the VBA code needed to run a macro that would achieve the above procedure?

Would really appreciate any help.

Thanks in advance.
LVL 1
gwh2Asked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

aikimarkCommented:
please post a representative sample workbook
gwh2Author Commented:
Hi, I've attached an excel file with sample data. Worksheet 1 contains some rows, while worksheet 2 is how the data should look once the macro has run.

Would be grateful for any help.

Thanks
test-data.xlsx
Ryan ChongBusiness Systems Analyst , ex-Senior Application EngineerCommented:
is the sku in sheet1 ALWAYS sorted according to its value?

I mean the same sku values are always grouped together?
CompTIA Network+

Prepare for the CompTIA Network+ exam by learning how to troubleshoot, configure, and manage both wired and wireless networks.

gwh2Author Commented:
Hi, thanks for the reply,

Yes the SKU values are always grouped together.
gwh2Author Commented:
If it helps, I already have the vba code which works part of the way as follows:

Option Explicit
Sub Insert_row()

Dim i As Long, myLastRow As Long

'Last row in range
myLastRow = Range("A1048576").End(xlUp).Row

'Put information at the bottom
Cells(myLastRow, 1).Value = Cells(myLastRow - 1, 1).Value
Cells(myLastRow, 2).Value = "configurable"

' Insert a row when value is not equal to the next row
For i = myLastRow To 2 Step -1

    If Cells(i, 1).Value <> Cells(i - 1, 1).Value Then
        Rows(i).Insert
        Cells(i, 1).Value = Cells(i - 1, 1).Value
        Cells(i, 2).Value = "configurable"
    End If

Next

MsgBox " Finished with inserting rows!!!"

End Sub

Open in new window


The problem with the above code is that for the copied rows, the code should only delete information found in columns B, C, D, E, F, G and H, whereas the above code is deleting the entire row with the exception of column A.

Also, the above code fails to complete the last step,  ie. it should look for any rows where column B has a value of "simple" (without the inverted commas). For any of those simple rows, it should delete the information found in columns I to AH.

I'm not sure if you can extend the code I already have or whether it's easier to begin anew.

Either way, I'd be grateful for any help.
Ryan ChongBusiness Systems Analyst , ex-Senior Application EngineerCommented:
try this...

Sub Insert_row()
    Dim ws As Worksheet
    'Get last Row
    lastR = Sheet1.Cells(Rows.Count, "A").End(xlUp).Row
    Range("A1:AH" & lastR).Select
    Selection.Copy
    Set ws = Sheets.Add(After:=Sheets(Sheets.Count))
    ActiveSheet.Paste
    Application.CutCopyMode = False
    'Create rows for Configurable
    tmp = ""
    Application.ScreenUpdating = False
    For i = lastR To 2 Step -1
        If ws.Cells(i, 1).Value <> ws.Cells(i - 1, 1).Value Then
            ws.Rows(i).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            ws.Rows(i + 1).Select
            Selection.Copy
            ws.Rows(i).Select
            ActiveSheet.Paste
            ws.Range("C" & i & ":H" & i).Select
            Selection.ClearContents
            ws.Range("I" & i + 1 & ":AH" & i + 1).Select
            Selection.ClearContents
            
            ws.Cells(i, 1).Value = ws.Cells(i + 1, 1).Value
            ws.Cells(i, 2).Value = "Configurable"
        Else
            ws.Range("I" & i & ":AH" & i).Select
            Selection.ClearContents
        End If
    Next
    'Get lastest last Row
    lastR = ws.Cells(Rows.Count, "A").End(xlUp).Row
    ws.Cells.EntireColumn.AutoFit
    ws.Cells(1, 1).Select
    Application.ScreenUpdating = True
    
End Sub

Open in new window

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
gwh2Author Commented:
Wow - that is fantastic!! Thank you so much - it works absolutely brilliantly and I really like how the result is inserted into the second worksheet. I'm really grateful.

I'd like to run a second macro whereby it hides all rows where the value in column B is equal to "Simple" so that only the Configurable rows are showing. This is because I would need to do more manual work just targeting the configurable rows. Could you let me know whether I need to ask this question in a new post or whether you can help further in this post?

Once again, this is so much appreciated.
aikimarkCommented:
I used subtotals to get the first part and then iterated the result:
Sub Q_28695553()
    Dim rng As Range
    Dim wks As Worksheet
    Set wks = ActiveSheet
    Application.DisplayAlerts = False
    wks.Cells(1, 1).CurrentRegion.Subtotal GroupBy:=1, Function:=xlCount, TotalList:=Array(2), _
        Replace:=True, PageBreaks:=False, SummaryBelowData:=False
    wks.Rows(2).Delete
    For Each rng In wks.Range(wks.Range("B2"), wks.Range("B2").End(xlDown))
        If IsNumeric(rng.Value) Then
            rng.Offset(0, -1).Value = rng.Offset(1, -1).Value
            rng.EntireRow.Range("I1:AH1").Value = rng.Offset(1).EntireRow.Range("I1:AH1").Value
            wks.Range(rng.Offset(1).EntireRow.Range("I1:AH1"), rng.Offset(rng.Value).EntireRow.Range("I1:AH1")).ClearContents
            rng.Value = "Configurable"
        End If
    Next
    Application.DisplayAlerts = True
End Sub

Open in new window

gwh2Author Commented:
Thanks very much for this second option. I noticed that your code processes the data a lot faster than the first option. Is that because the overall code length is a lot briefer? Also, is it possible to have the processed data inserted into a blank worksheet as the first option offered?
Ryan ChongBusiness Systems Analyst , ex-Senior Application EngineerCommented:
>>I'd like to run a second macro whereby it hides all rows where the value in column B is equal to "Simple" so that only the Configurable rows are showing.

Sub insert_row()
    Dim ws As Worksheet
    'Get last Row
    lastR = Sheet1.Cells(Rows.Count, "A").End(xlUp).Row
    Range("A1:AH" & lastR).Select
    Selection.Copy
    Set ws = Sheets.Add(After:=Sheets(Sheets.Count))
    ActiveSheet.Paste
    Application.CutCopyMode = False
    'Create rows for Configurable
    n = lastR
    Application.ScreenUpdating = False
    For i = lastR To 2 Step -1
        If ws.Cells(i, 1).Value <> ws.Cells(i - 1, 1).Value Then
            ws.Rows(i).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            ws.Rows(i + 1).Select
            Selection.Copy
            ws.Rows(i).Select
            ActiveSheet.Paste
            ws.Range("C" & i & ":H" & i).Select
            Selection.ClearContents
            ws.Range("I" & i + 1 & ":AH" & i + 1).Select
            Selection.ClearContents
            
            ws.Cells(i, 1).Value = ws.Cells(i + 1, 1).Value
            ws.Cells(i, 2).Value = "Configurable"
            
            'Group the items
            ws.Rows(i & ":" & n).Select
            n = i - 1
            Selection.Rows.Group
        Else
            ws.Range("I" & i & ":AH" & i).Select
            Selection.ClearContents
        End If
    Next
    'Get lastest last Row
    lastR = ws.Cells(Rows.Count, "A").End(xlUp).Row
    ws.Cells.EntireColumn.AutoFit
    ws.Cells(1, 1).Select
    Application.ScreenUpdating = True
    
End Sub

Open in new window

gwh2Author Commented:
Hi Ryan,

Thanks for the adjusted coded but I was after a second, separate macro to run in order to hide the simple rows. This is because I need to examine the data after the first macro is run and before hiding the rows. Is it possible to have the code in a separate vba block?
Ryan ChongBusiness Systems Analyst , ex-Senior Application EngineerCommented:
ok sure, you may customize this accordingly:

Sub insert_row()
    Dim ws As Worksheet
    'Get last Row
    lastR = Sheet1.Cells(Rows.Count, "A").End(xlUp).Row
    Range("A1:AH" & lastR).Select
    Selection.Copy
    Set ws = Sheets.Add(After:=Sheets(Sheets.Count))
    ActiveSheet.Paste
    Application.CutCopyMode = False
    'Create rows for Configurable
    'n = lastR
    Application.ScreenUpdating = False
    For i = lastR To 2 Step -1
        If ws.Cells(i, 1).Value <> ws.Cells(i - 1, 1).Value Then
            ws.Rows(i).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            ws.Rows(i + 1).Select
            Selection.Copy
            ws.Rows(i).Select
            ActiveSheet.Paste
            ws.Range("C" & i & ":H" & i).Select
            Selection.ClearContents
            ws.Range("I" & i + 1 & ":AH" & i + 1).Select
            Selection.ClearContents
            
            ws.Cells(i, 1).Value = ws.Cells(i + 1, 1).Value
            ws.Cells(i, 2).Value = "Configurable"
            
            'Group the items
            'ws.Rows(i & ":" & n).Select
            'n = i - 1
            'Selection.Rows.Group
        Else
            ws.Range("I" & i & ":AH" & i).Select
            Selection.ClearContents
        End If
    Next
    'Get lastest last Row
    lastR = ws.Cells(Rows.Count, "A").End(xlUp).Row
    ws.Cells.EntireColumn.AutoFit
    ws.Cells(1, 1).Select
    Application.ScreenUpdating = True
    
End Sub

Sub GroupItems()
    Dim ws As Worksheet
    Dim i As Integer
    Dim n As Integer
    'Assume the output is always last worksheet
    Set ws = Sheets(Sheets.Count)
    ws.Select
    
    'Get last Row
    lastR = ws.Cells(Rows.Count, "A").End(xlUp).Row
    n = lastR
    Application.ScreenUpdating = False
    For i = lastR To 2 Step -1
        If ws.Cells(i, 1).Value <> ws.Cells(i - 1, 1).Value Then
            'Group the items
            ws.Rows(i & ":" & n - 1).Select
            Selection.Rows.Group
            n = i - 1
        Else
            ws.Range("I" & i & ":AH" & i).Select
            Selection.ClearContents
        End If
    Next
    Application.ScreenUpdating = True
End Sub

Open in new window

gwh2Author Commented:
Hi Ryan,

Thanks again but I'm a bit confused. The code that you have given me includes both the original vba code to process the rows as outlined in my original post but it also includes the code for hiding the rows. My question is: can you please extract the parts of the code that hide the rows and put them into a separate vba code block so that I can run that macro to hide the rows separately. I just don't want to process the spreadsheet and hide the rows at the same time. Are you able to do this for me? If not, don't worry as I will ask a separate question on experts exchange.
Ryan ChongBusiness Systems Analyst , ex-Senior Application EngineerCommented:
>>can you please extract the parts of the code that hide the rows and put them into a separate vba code block so that I can run that macro to hide the rows separately
>>I just don't want to process the spreadsheet and hide the rows at the same time

actually you can call insert_row() and GroupItems() separately.

attached is my original works. Try click the buttons in Sheet1,

Button 1 to copy and format the data.
Button 2 to group the rows
test-data-b.xlsm
gwh2Author Commented:
I see what you mean - that's great but I tried running the GroupItems() after running the insert_row() but it didn't hide the rows. I'm using a mac computer so would that make a difference?
gwh2Author Commented:
Ryan, you said that Button 2 was to group the rows but I don't need them to be grouped. I need the rows that have the word "simple" in column B to be hidden, not grouped. Maybe you misunderstood what I meant. If yes, can you let me know or if you're not able to help right now can you let me know so I can post another separation question for someone else to answer?

Thanks
Ryan ChongBusiness Systems Analyst , ex-Senior Application EngineerCommented:
Ok, yup sorry as I was tight up at this moment, perhaps you can post another question if you need any urgent help.
gwh2Author Commented:
Ok no problem - I'll post another question. Thanks again.
aikimarkCommented:
The performance advantage comes in the use of the Subtotal method, the number of cells affected with each statement, and the (minimized) instances where the code actually acts on the cell contents.  So, the fewer number of statements you observed probably reflects these aspects.

In production, I usually sandwich the code like this
Application.ScreenUpdating = False
' code that
' changes cell contents
Application.ScreenUpdating = True

Open in new window

This is usually a big speed-up for even inefficient VBA code (cell-by-cell)
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.