Excel VBA Course

(35% Sale Ends Jan. 26)

Excel VBA Course - From Beginner to Expert

200+ Video Lessons
50+ Hours of Video
200+ Excel Guides

Become a master of VBA and Macros in Excel and learn how to automate all of your tasks in Excel with this online course. (No VBA experience required.)

View Course (35% Discount)

I need a vba and a advice


1. Active x button positions change by deleting row. Advice me to fixed the buttons

2. I need a vba please help, i dont want to remove duplicate all i want is to seperate 2 same color cell(entire row) by any other cell from above or below use as a seperator. Example between two coke rows i need any white row.



Hi Smhq and welcome to the Forum.

Sorry but I don't understand your point 2. Pleae EDIT your original question to expand the explanation and use the "Add files..." button to attach a representaive Excel file- without these, you may not get an answer.
John_Ru (rep: 2867) Nov 7, '21 at 7:46 am
I add a file related to my issue, all i need to do is to seperate 2 rows having same value(yellow color) by any other row from above or below between them.

Hope it help to clarify my problem. Thank for the response sir, originaly i have file with 1500rows daily and i  have to seperate these manually.

More clearly between two colorindex=6 i want vba to place a colorindex=2, 

I am so thankful once again
Smhq (rep: 2) Nov 7, '21 at 1:58 pm
Add to Discussion


Selected Answer


On your second question, the attached file has a clickable ActiveX control named "CommandButton1" on the example sheet. That has the commented code below which will loop through uall used rows in column 1 (A) which appears in bold below. When it finds a cell where the next cell is the same value and colour, it will add a blank row and the values from A and B. It also increases by 1 the number of rows to be checked in the Do/ Until loop: 

Private Sub CommandButton1_Click()

Dim LstRw As Long, n As Long

' Find last used row (before blanks are inserted)
LstRw = Cells(Rows.Count, 1).End(xlUp).Row
' Loop down used rows
    n = n + 1 ' increment row counter
    With Cells(n, 1)
        ' Check if current and next cells are same value and color
        If .Value = .Offset(1, 0).Value And .Interior.Color = .Offset(1, 0).Interior.Color Then
            '... then insert blank row below and increase last row
            .Offset(1, 0).EntireRow.Insert
            .Offset(1, 0).EntireRow.ClearFormats
            ' copy values
            .Offset(1, 0).Value = .Value
            .Offset(1, 1).Value = .Offset(0, 1).Value
            LstRw = LstRw + 1
        End If
    End With
'quit if (new) last row reached
Loop Until n = LstRw

End Sub
It will work if you have 1.500 used rows in or more in column A.

Regarding your first question, the ActiveX control is also "fixed" using a special event macro which triggers each time there's a change of selection (cell or range) on the worksheet . It just sets the Top and Left proprties of the ActiveX control to the numbers in bold below). That means that is stays where it is even when rows/columns and added or deleted.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' Need this for each ActiveX control
With ActiveSheet.OLEObjects("CommandButton1")
    .Top = ActiveWindow.VisibleRange.Top + 50
    .Left = ActiveWindow.VisibleRange.Left + 100
    .Placement = xlFreeFloating
End With

End Sub

Hope this helps.  



First of all really thankfull for your effort sir, sir the vba do the job for opening blank rows, mean i am half the way done. But i need the blanks to fill with data from above/below rows if posible. Cut paste.

I add a before after file. And love u sir thank u
Smhq (rep: 2) Nov 9, '21 at 7:19 am
Thanks for selecting my Answer Smhq. See my revised Answer and file- they  now add the same values for you. I think that is wrong (and think you want to shuffle rows or something) but I have no more time today or tomorrow to do anything on this.
John_Ru (rep: 2867) Nov 9, '21 at 7:33 am
No issue sir, i appreciate your work. Yes i want to shuffle and i understand the situation, over all i get some help by adding row. Thanks for that
Smhq (rep: 2) Nov 9, '21 at 8:10 am
Sorry I didn't understand your question properly. 
John_Ru (rep: 2867) Nov 9, '21 at 8:54 am
Add to Discussion
For 2 weeks I have not been able to find the answers with the work of the VBA and finally I read your answers, thanks.


Not sure what you mean, sorry.
John_Ru (rep: 2867) Nov 29, '21 at 7:53 am
Add to Discussion

Answer the Question

You must create an account to use the forum. Create an Account or Login