VBA/Macro issue

Fester675

Board Regular
Joined
Sep 16, 2016
Messages
141
I have recorded 2 Macros - one to copy a range of cells to the clipboard; the second to clear the relevant cells to start over.
I am a novice at VBA, so wondered how do I tidy things up; and how do I add in an extra piece of code to select extra rows dependent on whether they are empty or not?

TIA!!

VBA Code:
Sub Macro2_Export()
'
' Macro2_Export Macro
' Copies pre-selected cells to clipboard ready to paste into Oracle Loader.
'

'
    Range("R6,F6:J6,L6,N6:O6,Q6,S6").Select
    Range("S6").Activate
    ActiveWindow.LargeScroll ToRight:=1
    Range("R6,F6:J6,L6,N6:O6,Q6,S6,U6:V6,X6,Z6,AB6:AC6,AE6,AG6,AI6:AJ6,AL6").Select
    Range("AL6").Activate
    ActiveWindow.LargeScroll ToRight:=1
    Range( _
        "R6,F6:J6,L6,N6:O6,Q6,S6,U6:V6,X6,Z6,AB6:AC6,AE6,AG6,AI6:AJ6,AL6,AN6,AP6:AQ6,AS6,AU6,AW6:AX6,AZ6,BB6,BD6" _
        ).Select
    Range("BD6").Activate
    ActiveWindow.LargeScroll ToRight:=1
    Range( _
        "R6,F6:J6,L6,N6:O6,Q6,S6,U6:V6,X6,Z6,AB6:AC6,AE6,AG6,AI6:AJ6,AL6,AN6,AP6:AQ6,AS6,AU6,AW6:AX6,AZ6,BB6,BD6,BE6,BG6" _
        ).Select
    Range("BG6").Activate
    Selection.Copy
    ActiveWindow.ScrollColumn = 55
    ActiveWindow.ScrollColumn = 54
    ActiveWindow.ScrollColumn = 53
    ActiveWindow.ScrollColumn = 51
    ActiveWindow.ScrollColumn = 50
    ActiveWindow.ScrollColumn = 47
    ActiveWindow.ScrollColumn = 44
    ActiveWindow.ScrollColumn = 40
    ActiveWindow.ScrollColumn = 36
    ActiveWindow.ScrollColumn = 31
    ActiveWindow.ScrollColumn = 27
    ActiveWindow.ScrollColumn = 22
    ActiveWindow.ScrollColumn = 18
    ActiveWindow.ScrollColumn = 14
    ActiveWindow.ScrollColumn = 10
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 1
    Range("D6").Select
End Sub
____________________________________________________________________________________
VBA Code:
Sub Macro1_Clear()
'
' Macro1_Clear Macro
' Selects relevant cells & clears contents.
'

'
    Range("D6,E6,F6,H6,I6,K6,M6,O6,P6,R6,T6").Select
    Range("T6").Activate
    ActiveWindow.LargeScroll ToRight:=1
    Range("D6,E6,F6,H6,I6,K6,M6,O6,P6,R6,T6,V6,W6,Y6,AA6,AC6,AD6,AF6,AH6,AJ6,AK6"). _
        Select
    Range("AK6").Activate
    ActiveWindow.LargeScroll ToRight:=1
    ActiveWindow.SmallScroll ToRight:=-1
    Range( _
        "D6,E6,F6,H6,I6,K6,M6,O6,P6,R6,T6,V6,W6,Y6,AA6,AC6,AD6,AF6,AH6,AJ6,AK6,AM6,AO6,AQ6,AR6,AT6,AV6,AX6,AY6,BA6,BC6" _
        ).Select
    Range("BC6").Activate
    ActiveWindow.LargeScroll ToRight:=1
    Union(Range( _
        "BF6,D6,E6,F6,H6,I6,K6,M6,O6,P6,R6,T6,V6,W6,Y6,AA6,AC6,AD6,AF6,AH6,AJ6,AK6,AM6,AO6,AQ6,AR6,AT6,AV6,AX6,AY6,BA6,BC6" _
        ), Range("BE6")).Select
    Range("BF6").Activate
    Selection.ClearContents
    Range("D6").Select
End Sub
 
Last edited by a moderator:

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.
Tidied-up :
VBA Code:
Sub Macro2_Export()
' Copies pre-determined cells to clipboard ready to paste into Oracle Loader.
Range("R6,F6:J6,L6,N6:O6,Q6,S6,U6:V6,X6,Z6,AB6:AC6,AE6,AG6,AI6:AJ6,AL6,AN6," _
    & "AP6:AQ6,AS6,AU6,AW6:AX6,AZ6,BB6,BD6,BE6,BG6").Copy
Range("D6").Select
End Sub
____________________________________________________________________________________
Sub Macro1_Clear()
' Clears contents from relevant cells.
Range("BF6,D6:F6,H6,I6,K6,M6,O6,P6,R6,T6,V6,W6,Y6,AA6," _
    & "AC6,AD6,AF6,AH6,AJ6,AK6,AM6,AO6,AQ6,AR6,AT6,AV6,AX6," _
    & "AY6,BA6,BC6,BE6").ClearContents
Range("D6").Select
End Sub

"how do I add in an extra piece of code to select extra rows dependent on whether they are empty or not?"
More info required - what columns and based on what criteria?
What do you want to do with these "extra rows"?
 
Upvote 0
Oh my! That's fantastic footoo!!

"how do I add in an extra piece of code to select extra rows dependent on whether they are empty or not?"
More info required - what columns and based on what criteria?
What do you want to do with these "extra rows"?

Ok - so I have been testing in one row only. I need to now duplicate the full row to approximately 200 rows - It's to run in conjunction with the VBA above - so within 'Export' I want it to start at D6 and check each subsequent row in the same column, if it has an entry then COPY row 7 for the same cells as row 6.
And the same with the Clear. Hope it makes sense!
 
Upvote 0
• Is there any data in rows below the relevant columns' last row with data?
If not :
VBA Code:
Sub Macro1_Clear()
' Clears contents from relevant cells.
Dim rng As Range
Set rng = Range("D6:F6,H6,I6,K6,M6,O6,P6,R6,T6,V6,W6,Y6,AA6," _
    & "AC6,AD6,AF6,AH6,AJ6,AK6,AM6,AO6,AQ6,AR6,AT6,AV6,AX6," _
    & "AY6,BA6,BC6,BE6,BF6")
Intersect(rng.EntireColumn, Rows("6:" & Rows.Count)).ClearContents
End Sub
• If the above is not suitable, is there a column that can be used to determine the last data row for the relevant columns?

For the other macro, some questions :
• Do you mean that you want to check column D only and if it is not blank, copy the relevant cells for that row?
• Are there any formulas in the relevant cells?
• If there are formulas, any that can return "" ?
 
Upvote 0
In previous post, ignore this :
• Is there any data in rows below the relevant columns' last row with data?
If not :

and this :
• If the above is not suitable, is there a column that can be used to determine the last data row for the relevant columns?
 
Upvote 0
Thanks footoo.

For the other macro, some questions :
• Do you mean that you want to check column D only and if it is not blank, copy the relevant cells for that row? Yes. As this column/row will be the first cell to be filled. And it is mandatory, so it's blank until used.

• Are there any formulas in the relevant cells? Yes.
• If there are formulas, any that can return "" ? Yes.
 
Upvote 0
• Do you mean that you want to check column D only and if it is not blank, copy the relevant cells for that row? Yes. As this column/row will be the first cell to be filled. And it is mandatory, so it's blank until used.

Does that mean that column D has no gaps in the data?
If so :
VBA Code:
Sub Macro2_Export()
Dim rng As Range
Set rng = Range("R6,F6:J6,L6,N6:O6,Q6,S6,U6:V6,X6,Z6,AB6:AC6,AE6,AG6,AI6:AJ6," _
    & "AL6,AN6,AP6:AQ6,AS6,AU6,AW6:AX6,AZ6,BB6,BD6,BE6,BG6")
Intersect(rng.EntireColumn, Rows("6:" & Cells(Rows.Count, "D").End(3).Row)).Copy
End Sub
 
Upvote 0
'D' is blank until a new row needs to be started, whereby 'D' will be the first cell to be completed
 
Upvote 0
I'll check it as soon as I can footoo, and let you know. I'm UK time so might not be until after lunch.
But massive thanks nonetheless!!
 
Upvote 0

Forum statistics

Threads
1,213,487
Messages
6,113,943
Members
448,534
Latest member
benefuexx

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