Solved EXCEL macro to copy paste row below when value changes?

Microsoft Excel 2010 - complete product...
February 9, 2018 at 14:11:48
Specs: windows 7
I have a table of customer information by date and Tier Status

col.A    col.B   col.C   col.D   col.E   colF 

Cust#   MAY    JUN      JUL       AUG     DEC

cust1   T1      T1       T1       T1       T1

cust2   T2      T2       T3       T3       T3

cust3   T3      T3       T3       T4       T4

I would like to see a new row for every change in tier

col.A col.B col.C col.D col.E colF.

Cust    MAY   JUN  JUL   AUG   DEC

cust1   T1    T1    T1    T1   T1

cust2   T2    T2     -     -    -

cust2    -     -    T3    T3   T3

cust3   T3    T3    T3     -    -

cust3   -      -     -    T4   T4


Is there an EXCEL macro to copy paste row below when value changes? I can delete the dups between rows manually if that it too hard for EXCEL to figure out. Thanks in advance!

message edited by kesha1118


See More: EXCEL macro to copy paste row below when value changes?

Reply ↓  Report •

✔ Best Answer
February 14, 2018 at 11:40:27
OK, so this seems to work with one big assumption:

Customers are only upgraded, never downgraded.

e.g. This is OK...

Cust 1    T1   T1   T1   T2   T3

...but this is not:

Cust 1    T1   T1   T2   T1   T1

If there are downgrades in your customer's futures, this will take a lot more work. As written it does create new rows for both upgrades and downgrades - because new rows are created at any change - however, it only clears cells for upgrades. It basically ignores downgrades when the section that clears cells is executed.

Give this a try and let me know what you think. I will mention that I am not completely thrilled with the code, because it basically checks each cell one by one, which could make it slow for very large databases. I've tried various methods and the only way I could get it to work was to check each cell for "less than" or "greater than" the next cell to determine which cells to clear.

Sub TierRows()
'Prevent screen updates to speed up the code
 Application.ScreenUpdating = False
 
'Determine last Row with original data in Column A
 last_org_rw = Cells(Rows.Count, 1).End(xlUp).Row
 
'Loop through Rows in reverse order
  For rw = last_org_rw To 2 Step -1

'Initalize Tier Count variable for each new row
   tier_cnt = 0

'Loop through Columns, Counting changes
    For col = 2 To 5
     If Cells(rw, col) <> Cells(rw, col + 1) Then
      tier_cnt = tier_cnt + 1
     End If
    Next

'Insert rows based on number of changes
    For ins_rw = 1 To tier_cnt
     Cells(rw, 1).EntireRow.Copy
     Cells(rw, 1).EntireRow.Insert
    Next
  Next
  
'Determine last Row with expanded data in Column A
 last_exp_rw = Cells(Rows.Count, 1).End(xlUp).Row

'Loop through cells looking for differences
  For rw = 2 To last_exp_rw
   For col = 2 To 5

'Clear to end of Row if current cell is less than next cell
    If Cells(rw, col) < Cells(rw, col + 1) Then
     Range(Cells(rw, col + 1), Cells(rw, 6)).ClearContents
      rw = rw + 1
    End If
   
'Clear from beginning of Row if current cell is greater than previous cell
   If Cells(rw, col) < Cells(rw, col + 1) Then
    Range(Cells(rw, 2), Cells(rw, col)).ClearContents
   End If

  Next
 Next
End Sub

How To Post Data or Code ---> Click Here Before Posting Data or VBA Code

message edited by DerbyDad03



#1
February 9, 2018 at 19:56:38
In your example, you never have more than 2 different tiers. Is that always the case, or might you have something like this?

cust2   T2      T2       T3       T4       T4

How To Post Data or Code ---> Click Here Before Posting Data or VBA Code


Reply ↓  Report •

#2
February 12, 2018 at 10:49:03
Good Day!

Yes, there are 10 tiers that the customer could potentially be. Also not very clear in my example but this is forecast data. May 2018-December 2018.


Reply ↓  Report •

#3
February 12, 2018 at 11:46:50
Thanks for the info on the 10 tiers.

re: "Also not very clear in my example but this is forecast data. May 2018-December 2018."

Please keep in mind that we can't see your workbook from where we are sitting nor do we know anything about your work process. I assume that you had a good reason for adding that piece of information, but I don't know how it applies to your original question. How does that information impact the splitting of the rows at each change of tier?

How To Post Data or Code ---> Click Here Before Posting Data or VBA Code


Reply ↓  Report •

Related Solutions

#4
February 12, 2018 at 11:54:16
In my mind historical or forecast should make no difference. I simply wanted to provide all relevant information pertaining to the example above.

Reply ↓  Report •

#5
February 13, 2018 at 03:48:03

Reply ↓  Report •

#6
February 14, 2018 at 05:53:21
Hey, sorry for the delay, my real job got hectic. :-)

The following code is pretty simplistic and only meets half of your requirements: It adds rows based on the number of changes in Columns B:F. As of now, it does not delete the duplicates. I'm still working on that.

As a bonus, I included a "clean up" macro so that you can reset your data to the original while you are testing the code. Assuming that your original data is in Sheet1, copy it to Sheet2 and leave it there. When you want to reset Sheet1 to the original data, just run the clean up macro and it will copy Sheet2 back to Sheet1.

I do have one question before I continue working on the deletion part of the code. You showed hyphens in your example data. Are those supposed to be blank cells or actual hyphens? That makes a big difference in how the code will be written.

Here's the "Add Rows" code:

Sub TierRows()

'Determine last Row with data in Column A
 last_rw = Cells(Rows.Count, 1).End(xlUp).Row
 
'Loop through Rows in reverse order
  For rw = last_rw To 2 Step -1

'Initalize Tier Count variable for each new row
   tier_cnt = 0

'Loop through Columns, Counting changes
    For col = 2 To 5
     If Cells(rw, col) <> Cells(rw, col + 1) Then
      tier_cnt = tier_cnt + 1
     End If
    Next

'Insert rows based on number of changes
    For ins_rw = 1 To tier_cnt
     Cells(rw, 1).EntireRow.Copy
     Cells(rw, 1).EntireRow.Insert
    Next
  Next
End Sub

Here's the "Clean Up" code:

Sub CleanUp()
  Sheets(2).Cells.Copy Sheets(1).Cells(1, 1)
End Sub

How To Post Data or Code ---> Click Here Before Posting Data or VBA Code


Reply ↓  Report •

#7
February 14, 2018 at 07:41:25
THANK YOU SOOO MUCH!!!

This is perfect and and takes out a lot of the manual work already so take your time on the deletion.

the '-' in the example represent blank cells BUT for my user either is fine so whatever is cleaner to create will work .

Thank you again


Reply ↓  Report •

#8
February 14, 2018 at 11:40:27
✔ Best Answer
OK, so this seems to work with one big assumption:

Customers are only upgraded, never downgraded.

e.g. This is OK...

Cust 1    T1   T1   T1   T2   T3

...but this is not:

Cust 1    T1   T1   T2   T1   T1

If there are downgrades in your customer's futures, this will take a lot more work. As written it does create new rows for both upgrades and downgrades - because new rows are created at any change - however, it only clears cells for upgrades. It basically ignores downgrades when the section that clears cells is executed.

Give this a try and let me know what you think. I will mention that I am not completely thrilled with the code, because it basically checks each cell one by one, which could make it slow for very large databases. I've tried various methods and the only way I could get it to work was to check each cell for "less than" or "greater than" the next cell to determine which cells to clear.

Sub TierRows()
'Prevent screen updates to speed up the code
 Application.ScreenUpdating = False
 
'Determine last Row with original data in Column A
 last_org_rw = Cells(Rows.Count, 1).End(xlUp).Row
 
'Loop through Rows in reverse order
  For rw = last_org_rw To 2 Step -1

'Initalize Tier Count variable for each new row
   tier_cnt = 0

'Loop through Columns, Counting changes
    For col = 2 To 5
     If Cells(rw, col) <> Cells(rw, col + 1) Then
      tier_cnt = tier_cnt + 1
     End If
    Next

'Insert rows based on number of changes
    For ins_rw = 1 To tier_cnt
     Cells(rw, 1).EntireRow.Copy
     Cells(rw, 1).EntireRow.Insert
    Next
  Next
  
'Determine last Row with expanded data in Column A
 last_exp_rw = Cells(Rows.Count, 1).End(xlUp).Row

'Loop through cells looking for differences
  For rw = 2 To last_exp_rw
   For col = 2 To 5

'Clear to end of Row if current cell is less than next cell
    If Cells(rw, col) < Cells(rw, col + 1) Then
     Range(Cells(rw, col + 1), Cells(rw, 6)).ClearContents
      rw = rw + 1
    End If
   
'Clear from beginning of Row if current cell is greater than previous cell
   If Cells(rw, col) < Cells(rw, col + 1) Then
    Range(Cells(rw, 2), Cells(rw, col)).ClearContents
   End If

  Next
 Next
End Sub

How To Post Data or Code ---> Click Here Before Posting Data or VBA Code

message edited by DerbyDad03


Reply ↓  Report •

Ask Question