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

Bret1

Board Regular
Joined
Jun 14, 2013
Messages
199
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
 
Are you saying that you found a solution to this latest twist, or do you still need help implementing it?

Thanks for responding back. I apologize for being confusing and "jumpy". Just excited about your help. I still need help implementing it. The last code you wrote works great for what I requested, but I realized though that I need one more addition to make it work....
If "J" is blank, compare "A" with "U" on that row.... If they match, continue. If not, stop the Macro with a Pop Up at that point stating " "A" and "U" don't match. Macro stopped here. "
When comparing cells "A" and "U", compare only the 1st 5 characters (the rest will probably be different).
Again.... Thank you so much for your help on this! I apologize for the additions. But this update should do it!
Thanks!
 
Upvote 0

Excel Facts

Show numbers in thousands?
Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand
Try this:
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 is empty
    If Cells(r, "J") = "" Then
'       Check to see if if the first 5 characters or columns A and U match
        If Left(Cells(r, "A"), 5) = Left(Cells(r, "U"), 5) 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
        Else
'           What to do if columns A and U do not match
            MsgBox "Columns A and U do not match on row " & r, vbOKOnly, "MACRO STOPPED!!!"
            Exit Sub
        End If
    End If
Next r

Application.ScreenUpdating = False

End Sub
 
Upvote 0
ALmo
Try this:
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 is empty
    If Cells(r, "J") = "" Then
'       Check to see if if the first 5 characters or columns A and U match
        If Left(Cells(r, "A"), 5) = Left(Cells(r, "U"), 5) 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
        Else
'           What to do if columns A and U do not match
            MsgBox "Columns A and U do not match on row " & r, vbOKOnly, "MACRO STOPPED!!!"
            Exit Sub
        End If
    End If
Next r

Application.ScreenUpdating = False

End Sub

Almost works, but.....
It appears to be inserting a row when "J" is blank and "A" and "U" match, then when it finds the next blank "J" and "A" and "U" don't match, it stops, with pop up.
SHOULD BE.... If "J" is blank and it compares "A" and "U" and they match, nothing should happen. It should just continue..... If "A" and "U" don't match, then it should stop (as it currently does).
 
Upvote 0
I am confused now (it is hard to keep up when you keep changing the conditions!).
Then when should it do the whole script action you originally had (i.e inserting, copying, transposing, etc)?
 
Upvote 0
I am confused now (it is hard to keep up when you keep changing the conditions!).
Then when should it do the whole script action you originally had (i.e inserting, copying, transposing, etc)?

I can see that it is so close to working......
It's running the main script as it should. If "J" is blank it's comparing "A" and "U" as it should.... But, when "A" and "U" match, it's currently inserting a row at that line. That is the only problem. If "A" and "U" match, it should just continue the main script at that point without any changes. If "A" and "U" don't match, stop Macro at that point with a pop=up (this part is currently working)..
 
Upvote 0
Hmmm, that really does not clarify anything for me.

Specially, exactly WHEN should this part of your code run?
VBA Code:
            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

Or better yet, let's approach it this way. Let's call the code block above "BLOCK1".

Now, lay out all the conditions in which:
1. When should "BLOCK1" run?
2. When should the MsgBox pop-up and the macro stop?
3. When should it just skip over a line and proceed to the next line of data without doing anything?
 
Upvote 0
Hmmm, that really does not clarify anything for me.

Specially, exactly WHEN should this part of your code run?
VBA Code:
            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

Or better yet, let's approach it this way. Let's call the code block above "BLOCK1".

Now, lay out all the conditions in which:
1. When should "BLOCK1" run?
2. When should the MsgBox pop-up and the macro stop?
3. When should it just skip over a line and proceed to the next line of data without doing anything?

Since I don't understand code, it may be best for me to start from beginning....
Starting at Row 17, compare "J" to "V", if they match, go to next row. If they don't match, run the code below (or your abbreviated version) FOR THAT ROW, then continue to next row...
Code:
Sub Macro2()
'
' Macro2 Macro
'
    Rows("183:183").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    ActiveWindow.SmallScroll Down:=6
    Range("A183:S183").Select
    Selection.Delete Shift:=xlUp
    Range("J183").Select
    Selection.Copy
    Range("V183").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWindow.Panes(4).Activate
    Range("KB183").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End Sub

If "J" is blank, compare "A" and "U" for that row. If their 1st 5 characters match, continue to next row. If "A" and "U" do not match, stop Macro at that point with pop-up stating " "A" and "U" don't match. Macro Stopped."

The end of the data where Macro completes could be row 5,000, or when "J" is blank 5 consecutive rows.
 
Upvote 0
Is it possible that both columns J and V could be blank in the same row?
If so, which of your conditions should take precedence over the other?
- If J is blank, then do...
- If J and V are equal, then do...
 
Upvote 0
Is it possible that both columns J and V could be blank in the same row?
If so, which of your conditions should take precedence over the other?
- If J is blank, then do...
- If J and V are equal, then do...

There are no blanks on "V".
If "J" is blank, compare "A" to "U" (1st 5 characters). If they match, continue to next row with no changes. If they don't match, stop Macro with pop-up at that point stating " "A" and "U" don't match.".
 
Upvote 0

Forum statistics

Threads
1,215,641
Messages
6,125,984
Members
449,276
Latest member
surendra75

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
Back
Top