Change attached code to affect the current highlighted row(s) when run?

Bret1

Board Regular
Joined
Jun 14, 2013
Messages
157
Hi,
Can you please help me change the attached code to affect only the current highlighted row(s)?
In this example, everywhere that row "741" is displayed, should be changed to whatever row is currently highlighted when macro is run... (or to whatever row the "A" column is selected - whichever is easier.)
Thanks!

Code:
Sub Macro1()
'
' Macro1 Macro
'
'
Rows("741:741").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A741:S741").Select
Selection.Delete Shift:=xlUp
Range("J741").Select
Selection.Copy
Range("V741").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWindow.Panes(4).Activate
Range("KB741").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
 

Excel Facts

How to create a cell-sized chart?
Tiny charts, called Sparklines, were added to Excel 2010. Look for Sparklines on the Insert tab.

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
58,334
Office Version
  1. 365
Platform
  1. Windows
Note that you can also get rid of most of those "Select" statements that you got using the Macro Recorder.
Most of the time, if you have one line that ends in "Select", and the next that begins with "Selection", you can usually combine them together.

See if this works for you:
VBA Code:
Sub Macro1()

Dim r As Long

'Get the row the activecell is in
r = ActiveCell.Row

Rows(r).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A" & r & ":S" & r).Delete Shift:=xlUp
Range("J" & r).Copy
Range("V" & r).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Range("KB" & r).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

End Sub
 
Solution

Bret1

Board Regular
Joined
Jun 14, 2013
Messages
157
Note that you can also get rid of most of those "Select" statements that you got using the Macro Recorder.
Most of the time, if you have one line that ends in "Select", and the next that begins with "Selection", you can usually combine them together.

See if this works for you:
VBA Code:
Sub Macro1()

Dim r As Long

'Get the row the activecell is in
r = ActiveCell.Row

Rows(r).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A" & r & ":S" & r).Delete Shift:=xlUp
Range("J" & r).Copy
Range("V" & r).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Range("KB" & r).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

End Sub

That worked! Thank you!
Now that that works, would it be possible to change it slightly? Instead of running the code only on the current "active" row, would it be possible to have it start on Row 17, and run the Macro only on each row WHERE COLUMNS "J" AND "V" DO NOT MATCH? (Running the Macro makes "J" and "V" match on that row on my sheet). I would never have any info past row 5,000 if it matters. If it would run on each row where they don't match (starting with Row 17), that would save me a ton of time manually doing this.
 

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
58,334
Office Version
  1. 365
Platform
  1. Windows
See if this does what you want:
VBA Code:
Sub Macro1()

Dim lr As Long
Dim r As Long

Application.ScreenUpdating = True

'Find last row in column J with data
lr = Cells(Rows.Count, "J").End(xlUp).Row

'Loop through all rows starting in row 17
For r = 17 To lr
'   Check to see if columns J and V are not equal
    If Cells(r, "J") <> Cells(r, "V") Then
        Rows(r).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        Range("A" & r & ":S" & r).Delete Shift:=xlUp
        Range("J" & r).Copy
        Range("V" & r).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Range("KB" & r).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    End If
Next r

Application.ScreenUpdating = False

End Sub
If it does not, I think we will need to see an example of what your starting data looks like, and what you want the ending result to look like.
 

Bret1

Board Regular
Joined
Jun 14, 2013
Messages
157

ADVERTISEMENT

See if this does what you want:
VBA Code:
Sub Macro1()

Dim lr As Long
Dim r As Long

Application.ScreenUpdating = True

'Find last row in column J with data
lr = Cells(Rows.Count, "J").End(xlUp).Row

'Loop through all rows starting in row 17
For r = 17 To lr
'   Check to see if columns J and V are not equal
    If Cells(r, "J") <> Cells(r, "V") Then
        Rows(r).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        Range("A" & r & ":S" & r).Delete Shift:=xlUp
        Range("J" & r).Copy
        Range("V" & r).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Range("KB" & r).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    End If
Next r

Application.ScreenUpdating = False

End Sub
If it does not, I think we will need to see an example of what your starting data looks like, and what you want the ending result to look like.

WOW!!!! I think that worked perfect! I've been doing this manually for a while. Thank you so much!
 

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
58,334
Office Version
  1. 365
Platform
  1. Windows
You are welcome.
Glad I was able to help, and hope it all makes sense.
Let me know if you have any questions about what I did.
 

Bret1

Board Regular
Joined
Jun 14, 2013
Messages
157

ADVERTISEMENT

You are welcome.
Glad I was able to help, and hope it all makes sense.
Let me know if you have any questions about what I did.
I found one issue I think is simple I hope you will help me with. Your Macro works perfect for what I asked, but the way my sheet is, it may not work right sometimes.
What I need it to do is also check if the cell in column "J" is blank. If it is, stop the Macro, and at that cell have it pop-pop asking to "Stop, or Continue?".

Sometimes, new info is added at these points, which require different steps before continuing as before. I can easily check at each point if it notifies me, and correct and re-run Macro, or continue.
 

Bret1

Board Regular
Joined
Jun 14, 2013
Messages
157
I found one issue I think is simple I hope you will help me with. Your Macro works perfect for what I asked, but the way my sheet is, it may not work right sometimes.
What I need it to do is also check if the cell in column "J" is blank. If it is, stop the Macro, and at that cell have it pop-pop asking to "Stop, or Continue?".

Sometimes, new info is added at these points, which require different steps before continuing as before. I can easily check at each point if it notifies me, and correct and re-run Macro, or continue.
Wait.... I found better solution... SORRY.....
If "J" is blank, compare, "A" with "U" on that row.... If they match, continue. If not, stop Macro with POP up at that point saying ""A" and "J" don't match. Macro stopped here."
 

Bret1

Board Regular
Joined
Jun 14, 2013
Messages
157
You are welcome.
Glad I was able to help, and hope it all makes sense.
Let me know if you have any questions about what I did.

Wait.... I found better solution... SORRY.....
If "J" is blank, compare, "A" with "U" on that row.... If they match, continue. If not, stop Macro with Pop Up at that point stating " "A" and "U" don't match. Macro stopped here. "
If comparing cells "A" and "U", only the 1st 5 characters need to be compared (the rest may be different).
Again.... Thank you so much for your help on this! I apologize for the additions. But this update should do it!
Thanks!
 

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
58,334
Office Version
  1. 365
Platform
  1. Windows
Wait.... I found better solution... SORRY.....
If "J" is blank, compare, "A" with "U" on that row.... If they match, continue. If not, stop Macro with Pop Up at that point stating " "A" and "U" don't match. Macro stopped here. "
If comparing cells "A" and "U", only the 1st 5 characters need to be compared (the rest may be different).
Again.... Thank you so much for your help on this! I apologize for the additions. But this update should do it!
Thanks!
Are you saying that you found a solution to this latest twist, or do you still need help implementing it?
 

Forum statistics

Threads
1,136,733
Messages
5,677,445
Members
419,693
Latest member
divtjd

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
Top