Modify VBA Code for more Customization

A

ameenuksg

Board Regular
Joined
Jul 11, 2017
Messages
83
Hi All

I have posted here a group of VBA codes which I would like to modify to expand the functionality and consolidate into one single code. What I want it to do:

1. Open a file and copy the entire table of data after it has been filtered with columns and rows hidden. But the code below only copies a certain range instead of the entire table.

Sub wbCopyFrom()
Dim vFile As Variant
Dim wbCopyTo As Workbook
Dim wsCopyTo As Worksheet
Dim wbCopyFrom As Workbook
Dim wsCopyFrom As Worksheet


Set wbCopyTo = ActiveWorkbook
Set wsCopyTo = ActiveSheet


'-------------------------------------------------------------
'Open file with data to be copied

vFile = Application.GetOpenFilename("Excel Files (*.xl*)," & _
"*.xl*", 1, "Select Excel File", "Open", False)

'If Cancel then Exit
If TypeName(vFile) = "Boolean" Then
Exit Sub
Else
Set wbCopyFrom = Workbooks.Open(vFile)
Set wsCopyFrom = wbCopyFrom.Worksheets(1)
End If

'--------------------------------------------------------------
'Copy Range
wsCopyFrom.Range("B6:E12").Copy
wsCopyTo.Range("A1").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False


End Sub


2. So before the copying and pasting, I want the VBA to hide some rows and columns:

Sub HideColsnRows()
'
' HideColsnRows Macro
' Hide unwanted columns and rows for billing
'


'
Rows("1:3").Select
Selection.EntireRow.Hidden = True
Columns("A:A").Select
Range("A4").Activate
Selection.EntireColumn.Hidden = True
Columns("G:G").Select
Range("G4").Activate
Selection.EntireColumn.Hidden = True
Columns("I:Q").Select
Range("I4").Activate
Selection.EntireColumn.Hidden = True
Columns("T:W").Select
Range("T4").Activate
Selection.EntireColumn.Hidden = True
Columns("AF:AF").Select
Range("AF4").Activate
Selection.EntireColumn.Hidden = True
Columns("AI:AL").Select
Range("AI4").Activate
Selection.EntireColumn.Hidden = True
Columns("AM:AP").Select
Range("AM4").Activate
Selection.EntireColumn.Hidden = True
Columns("AQ:AQ").Select
Range("AQ4").Activate
Selection.EntireColumn.Hidden = True
End Sub




3. Then I want it to filter data certain data before pasting:

Sub FilterInPoDirectCPH()
'
' FilterInPoDirectCPH Macro
' Filter Inside Port direct & indirect with MDT CPH
'


'
ActiveSheet.ListObjects("Table132415").Range.AutoFilter Field:=3, Criteria1 _
:="=Inside Port Direct", Operator:=xlOr, Criteria2:= _
"=Inside Port Indirect"
ActiveSheet.ListObjects("Table132415").Range.AutoFilter Field:=8, Criteria1 _
:="MDT CPH"
End Sub


Can anybody help me with this? I would gratefully appreciate any help in this and thank you in advance.
 

Excel Facts

How to change case of text in Excel?
Use =UPPER() for upper case, =LOWER() for lower case, and =PROPER() for proper case. PROPER won't capitalize second c in Mccartney
Sort by date Sort by votes
Perhaps This...

Code: 
Sub wbCopyFrom()

    Dim vFile As Variant
    Dim wbCopyFrom As Workbook, wbCopyTo As Workbook
    Dim wsCopyFrom As Worksheet, wsCopyTo As Worksheet

    Set wbCopyTo = ActiveWorkbook
    Set wsCopyTo = ActiveSheet

    vFile = Application.GetOpenFilename("Excel Files (*.xl*)," & "*.xl*", 1, "Select Excel File", "Open", False)

    If TypeName(vFile) = "Boolean" Then
       Exit Sub
    Else
        Set wbCopyFrom = Workbooks.Open(vFile)
        Set wsCopyFrom = wbCopyFrom.Worksheets(1)
    End If

    Rows("1:3").EntireRow.Hidden = True
    Application.Union(Columns("G"), Columns("I:Q"), Columns("T:W"), Columns("AF:AF"), Columns("AI:AQ")).EntireColumn.Hidden = True

    wsCopyFrom.range("B6:E12").SpecialCells(xlCellTypeVisible).Copy
 
    ActiveSheet.ListObjects("Table132415").range.AutoFilter Field:=3, Criteria1:="=Inside Port Direct", Operator:=xlOr, Criteria2:="=Inside Port Indirect"
    ActiveSheet.ListObjects("Table132415").range.AutoFilter Field:=8, Criteria1:="MDT CPH"
 
    wsCopyTo.range("A1").SpecialCells(xlCellTypeVisible).PasteSpecial Paste:=xlPasteValues

 End Sub
 
Upvote 0
Hi decadence

Thanks for helping me out here, but i got an error message at this point:

wsCopyTo.range("A1").SpecialCells(xlCellTypeVisible).PasteSpecial Paste:=xlPasteValues

Error msg:

Run-time error '1004':
PasteSpecial method of Range class failed

Not sure what it means, and it didnt paste anything at all



decadence said:
Perhaps This...

Code: 
Sub wbCopyFrom()

    Dim vFile As Variant
    Dim wbCopyFrom As Workbook, wbCopyTo As Workbook
    Dim wsCopyFrom As Worksheet, wsCopyTo As Worksheet

    Set wbCopyTo = ActiveWorkbook
    Set wsCopyTo = ActiveSheet

    vFile = Application.GetOpenFilename("Excel Files (*.xl*)," & "*.xl*", 1, "Select Excel File", "Open", False)

    If TypeName(vFile) = "Boolean" Then
       Exit Sub
    Else
        Set wbCopyFrom = Workbooks.Open(vFile)
        Set wsCopyFrom = wbCopyFrom.Worksheets(1)
    End If

    Rows("1:3").EntireRow.Hidden = True
    Application.Union(Columns("G"), Columns("I:Q"), Columns("T:W"), Columns("AF:AF"), Columns("AI:AQ")).EntireColumn.Hidden = True

    wsCopyFrom.range("B6:E12").SpecialCells(xlCellTypeVisible).Copy
 
    ActiveSheet.ListObjects("Table132415").range.AutoFilter Field:=3, Criteria1:="=Inside Port Direct", Operator:=xlOr, Criteria2:="=Inside Port Indirect"
    ActiveSheet.ListObjects("Table132415").range.AutoFilter Field:=8, Criteria1:="MDT CPH"
 
    wsCopyTo.range("A1").SpecialCells(xlCellTypeVisible).PasteSpecial Paste:=xlPasteValues

 End Sub
Click to expand...
 
Upvote 0
Hi ameenuksg, Are you wanting to copy B6:E12 before Filtering or After?
 
Upvote 0
Not Tested but give this a try...

Code: 
    Dim vFile As Variant
    Dim wbCopyFrom As Workbook, wbCopyTo As Workbook
    Dim wsCopyFrom As Worksheet, wsCopyTo As Worksheet

    Set wbCopyTo = ActiveWorkbook
    Set wsCopyTo = ActiveSheet

    vFile = Application.GetOpenFilename("Excel Files (*.xl*)," & "*.xl*", 1, "Select Excel File", "Open", False)

    If TypeName(vFile) = "Boolean" Then
       Exit Sub
    Else
        Set wbCopyFrom = Workbooks.Open(vFile)
        Set wsCopyFrom = wbCopyFrom.Worksheets(1)
    End If

    Rows("1:3").EntireRow.Hidden = True
    Application.Union(Columns("G"), Columns("I:Q"), Columns("T:W"), Columns("AF:AF"), Columns("AI:AQ")).EntireColumn.Hidden = True
    
    ActiveSheet.ListObjects("Table132415").range.AutoFilter Field:=3, Criteria1:="=Inside Port Direct", Operator:=xlOr, Criteria2:="=Inside Port Indirect"
    ActiveSheet.ListObjects("Table132415").range.AutoFilter Field:=8, Criteria1:="MDT CPH"
    
    wsCopyFrom.range("B6:E12").SpecialCells(xlCellTypeVisible).Copy
    With wsCopyTo
        .Activate
        .range("A1").Activate
        .Paste
    End With
 End Sub
 
Upvote 0
Nope..it didnt copy the entire table or sheet. I still see that a specific range is still mentioned 'wsCopyFrom.range("B6:E12").SpecialCells(xlCellTypeVisible).Copy' in your VBA


decadence said:
Not Tested but give this a try...

Code: 
    Dim vFile As Variant
    Dim wbCopyFrom As Workbook, wbCopyTo As Workbook
    Dim wsCopyFrom As Worksheet, wsCopyTo As Worksheet

    Set wbCopyTo = ActiveWorkbook
    Set wsCopyTo = ActiveSheet

    vFile = Application.GetOpenFilename("Excel Files (*.xl*)," & "*.xl*", 1, "Select Excel File", "Open", False)

    If TypeName(vFile) = "Boolean" Then
       Exit Sub
    Else
        Set wbCopyFrom = Workbooks.Open(vFile)
        Set wsCopyFrom = wbCopyFrom.Worksheets(1)
    End If

    Rows("1:3").EntireRow.Hidden = True
    Application.Union(Columns("G"), Columns("I:Q"), Columns("T:W"), Columns("AF:AF"), Columns("AI:AQ")).EntireColumn.Hidden = True
    
    ActiveSheet.ListObjects("Table132415").range.AutoFilter Field:=3, Criteria1:="=Inside Port Direct", Operator:=xlOr, Criteria2:="=Inside Port Indirect"
    ActiveSheet.ListObjects("Table132415").range.AutoFilter Field:=8, Criteria1:="MDT CPH"
    
    wsCopyFrom.range("B6:E12").SpecialCells(xlCellTypeVisible).Copy
    With wsCopyTo
        .Activate
        .range("A1").Activate
        .Paste
    End With
 End Sub
Click to expand...
 
Upvote 0
You must log in or register to reply here.

Similar threads

willow1985
  • Solved
Find first blank cell in column A in a Table - Runtime error 91
Replies
4
Views
104
willow1985
willow1985
M
  • Question
Table issue with VBA
Replies
0
Views
64
Mike2
M
S
  • Solved
Macro to filter each column for cells that appear empty, clear the contents and move to the next column for entire table
Replies
3
Views
135
sspatriots
S
Z
  • Solved
VBA Code to Hide columns in Specific Intervals
2
Replies
11
Views
387
jolivanes
jolivanes
G
  • Question
VBA help - copy cells from specific table to specific table on another sheet.
Replies
0
Views
289
GardianAngelUK
G

Forum statistics

Threads
1,214,967
Messages
6,122,503
Members
449,090
Latest member
RandomExceller01

Share this page

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