Modify VBA Code for more Customization

ameenuksg

Board Regular
Joined
Jul 11, 2017
Messages
79
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.
 

Some videos you may like

Excel Facts

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use $ signs: $V$2:$Z$99 will always point to V2:Z99, even after copying

decadence

Well-known Member
Joined
Oct 9, 2015
Messages
524
Office Version
  1. 365
  2. 2016
  3. 2013
  4. 2010
  5. 2007
Platform
  1. Windows
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
 

ameenuksg

Board Regular
Joined
Jul 11, 2017
Messages
79
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



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
 

decadence

Well-known Member
Joined
Oct 9, 2015
Messages
524
Office Version
  1. 365
  2. 2016
  3. 2013
  4. 2010
  5. 2007
Platform
  1. Windows
Hi ameenuksg, Are you wanting to copy B6:E12 before Filtering or After?
 

ameenuksg

Board Regular
Joined
Jul 11, 2017
Messages
79

ADVERTISEMENT

No, copy whatever shows on my sheet after hiding and filtering columns and rows.


Hi ameenuksg, Are you wanting to copy B6:E12 before Filtering or After?
 

decadence

Well-known Member
Joined
Oct 9, 2015
Messages
524
Office Version
  1. 365
  2. 2016
  3. 2013
  4. 2010
  5. 2007
Platform
  1. Windows
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
 

ameenuksg

Board Regular
Joined
Jul 11, 2017
Messages
79
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


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
 

Watch MrExcel Video

Forum statistics

Threads
1,114,084
Messages
5,545,870
Members
410,711
Latest member
Josh324
Top