Copying contiguous & non-contiguous cells using SpecialCells in VBA

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.
Sort by date Sort by votes
Please do not ask members to help on another site.
You need to post your question & data here.
 
Upvote 0
No you need to continue in this thread. I have removed your new one.
 
Upvote 0
Team, I want to filter data from a file and paste the information from the visible cells into a separate workbook.

The code works when I have multiple cells (greater than 1) filtered. When the data filtered is a single row, and if it is contiguous cells, it is not copying/selecting the mentioned range.

Code to select the visible range to copy:
VBA Code: 
If SATsht.AutoFilter.Range.Columns(11).SpecialCells(xlCellTypeVisible).Cells.Count - 1 < 1 Then
            AdditionsCount = SATsht.AutoFilter.Range.Columns(11).SpecialCells(xlCellTypeVisible).Cells.Count
            MsgBox "There are no New Additions after filtering out the Duplicate Activities"
            GoTo NextMARFilter
            'SATfile.Close False
            'Exit Sub
        End If
        AdditionsCount = SATsht.AutoFilter.Range.Columns(11).SpecialCells(xlCellTypeVisible).Cells.Count - 1
      
        'Update all the fields from SATfile to MARfile

        For X = 2 To SATCols

            On Error Resume Next
            Debug.Print SATsht.Cells(2, X)
            MARheader = Application.WorksheetFunction.Match(SATsht.Cells(2, X), MARheaderRng, 0)
            If Err.Number > 0 Then GoTo NextHeader
            On Error GoTo 0
          
            SATfile.Activate
            SATsht.Range(Cells(3, X), Cells(SATRows, X)).SpecialCells(xlCellTypeVisible).Select 'PROBLEM IS HERE
            Selection.Copy
            MARfile.Activate
            MARfile.Sheets(1).Cells(MARoldRows + 1, MARheader).PasteSpecial Paste:=xlPasteValues
          
NextHeader:
        Next

The line of code where I'm having issues:

VBA Code: 
SATsht.Range(Cells(3, X), Cells(SATRows, X)).SpecialCells(xlCellTypeVisible).Select

The code is selecting the entire visible range available instead of the mentioned visible cell.

Before Selection (in the code):
1688709107867.png


After Selection (in the code):
1688709128069.png


Logically it has to select the first visible cell (in this case E3) below the header and it needs to be repeated for each column one after the other.

I have attached the entire code below for your reference.

VBA Code: 
Option Explicit
Const PhraseConstString As String = "Password"
Dim strFile As String, SATfile As Workbook, SATsht As Worksheet
Dim SATRows As Long, SATCols As Long
Dim MARoldRows As Long
Dim MARnewRows As Long, MARCols As Long
Dim X As Long, Y As Long, Z As Long
Dim SATheader As Byte, MARheader As Byte
Dim SATheaderRng As Range, MARheaderRng As Range
Dim MARfile As Workbook
Dim DuplicateStr As String, DuplicateStrList As String
Dim EachActivity As Range, TotalRng As Range, MARrange As Range, SATrange As Range
Dim MARFilters(0 To 2) As String
Dim AdditionsCount As Long, DeletionsCount As Long, ModificationsCount As Long
Dim MDsht As Worksheet 'Modifications and deletions sheet
Dim MDrows As Long, MDcols As Long

Sub Add_New_Transitioned_Activities()

Application.ScreenUpdating = False

If MsgBox("Would you like to add the Newly Transitioned Activities?", vbYesNo, "New Transitioned Activities") = vbNo Then
    MsgBox "Execution Cancelled"
    Exit Sub
End If

'Unlock and unhide all sheets before execution
Call Unlock_UnhideAllSheets

'Select SATfile
strFile = Application.GetOpenFilename(Title:="Select the appropriate Standard Activities Template")
Application.DisplayAlerts = False
Workbooks.Open (strFile)
Application.DisplayAlerts = True

strFile = ActiveWorkbook.Name
Set SATfile = Workbooks(strFile)
Set SATsht = SATfile.Sheets("Activity")

'Filter out for New Transitioned Activity Line items
SATsht.AutoFilterMode = False
SATRows = SATsht.Range("B" & Rows.Count).End(xlUp).Row
SATCols = SATsht.Cells(2, Columns.Count).End(xlToLeft).Column

Set SATheaderRng = SATsht.Range(Cells(2, 2), Cells(2, SATCols))

'Applying Trim for Activity Name and New Activity Name Columns in SAT file
Set SATrange = SATsht.Range(Cells(3, 12), Cells(SATRows, 12)) 'Activity/Business Process Name column
With SATrange
    .Value = Evaluate(Replace("If(@="""","""",Trim(@))", "@", .Address))
End With

Set SATrange = SATsht.Range(Cells(3, 13), Cells(SATRows, 13)) ' New Activity Name column
With SATrange
    .Value = Evaluate(Replace("If(@="""","""",Trim(@))", "@", .Address))
End With

MARFilters(0) = "Addition of New Activity"
MARFilters(1) = "Deactivate Activity in the Master List"
MARFilters(2) = "Modify exisiting activity level details"

Set MARfile = ThisWorkbook
MARfile.Activate
MARfile.Sheets(1).AutoFilterMode = False
MARoldRows = MARfile.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
MARCols = MARfile.Sheets(1).Cells(1, Columns.Count).End(xlToLeft).Column
'Z = 2
For Z = 0 To 2
    If Z = 0 Then
        'if there are no New Additions, it would give msgbox and exit the process
        On Error Resume Next
        With SATsht
            .Activate
            .AutoFilterMode = False
            .Range(Cells(2, 1), Cells(SATRows, SATCols)).AutoFilter field:=2, Criteria1:="Addition of New Activity"
        End With
        If SATsht.AutoFilter.Range.Columns(12).SpecialCells(xlCellTypeVisible).Cells.Count - 1 < 1 Then
            MsgBox "There are no New Addions request, please cross-check"
            GoTo NextMARFilter
            'Call Lock_HideAllSheets
            'SATfile.Close False
            'Exit Sub
        End If
        On Error GoTo 0
      
        Set MARfile = ThisWorkbook
        MARfile.Activate
        'MARfile.Sheets(1).AutoFilterMode = False
      
        On Error Resume Next
        MARfile.Sheets(1).ShowAllData
        On Error GoTo 0
      
        MARoldRows = MARfile.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
        MARCols = MARfile.Sheets(1).Cells(1, Columns.Count).End(xlToLeft).Column
        Set MARheaderRng = MARfile.Sheets(1).Range(Cells(1, 1), Cells(1, MARCols))
      
        'Find Duplicate Activity Names and filter results out in SAT file
      
        MARheader = Application.WorksheetFunction.Match("Activity / Business Process Name", MARheaderRng, 0)
        Set MARrange = MARfile.Sheets(1).Range(Cells(2, MARheader), Cells(MARoldRows, MARheader))
      
        SATfile.Activate
        Set TotalRng = SATsht.Range(Cells(3, 12), Cells(SATRows, 12))
        'Set TotalRng = SATsht.Range(Cells(3, 12), Cells(SATRows, 12)).SpecialCells(xlCellTypeVisible)
      
        DuplicateStr = ""
        DuplicateStrList = ""
      
        'For Each EachActivity In TotalRng.SpecialCells(xlCellTypeVisible)
        '    If Application.WorksheetFunction.CountIf(MARrange, EachActivity) > 0 Then
        '        If DuplicateStr = "" Then
        '            DuplicateStr = EachActivity
        '            DuplicateStrList = "<>" & EachActivity
        '        Else
        '            DuplicateStr = DuplicateStr & vbNewLine & EachActivity
        '            DuplicateStrList = DuplicateStrList & "," & "<>" & EachActivity
        '        End If
        '    End If
        'Next
      
        'With SATfile.Sheets(1)
        '    '.Range(Cells(2, 1), Cells(SATRows, SATCols)).AutoFilter field:=11, Criteria1:="<>" & DuplicateStrList, Operator:=xlFilterValues
        '    '.Range(Cells(2, 1), Cells(SATRows, SATCols)).AutoFilter field:=11, Criteria1:="<>" & EachActivity, Operator:=xlFilterValues
        '    .Range(Cells(2, 1), Cells(SATRows, SATCols)).AdvancedFilter Action:=xlFilterInPlace, criteriarange:=MARrange, Unique:=False
        'End With
      
        For Each EachActivity In TotalRng.SpecialCells(xlCellTypeVisible)
            If Application.WorksheetFunction.CountIf(MARrange, EachActivity) > 0 Then
              
                EachActivity.Font.Color = vbRed
              
                If DuplicateStr = "" Then
                    DuplicateStr = EachActivity
                    DuplicateStrList = "<>" & EachActivity
                Else
                    DuplicateStr = DuplicateStr & vbNewLine & EachActivity
                    DuplicateStrList = DuplicateStrList & "," & "<>" & EachActivity
                End If
            End If
        Next
      
        With SATsht
            '.Range(Cells(2, 1), Cells(SATRows, SATCols)).AutoFilter field:=12, Criteria1:=RGB(0, 32, 96), Operator:=xlFilterFontColor, Criteria2:=RGB(0, 0, 0)
            .Range(Cells(2, 1), Cells(SATRows, SATCols)).AutoFilter field:=12, Operator:=xlFilterAutomaticFontColor
        End With
      
        If SATsht.AutoFilter.Range.Columns(11).SpecialCells(xlCellTypeVisible).Cells.Count - 1 < 1 Then
            AdditionsCount = SATsht.AutoFilter.Range.Columns(11).SpecialCells(xlCellTypeVisible).Cells.Count
            MsgBox "There are no New Additions after filtering out the Duplicate Activities"
            GoTo NextMARFilter
            'SATfile.Close False
            'Exit Sub
        End If
        AdditionsCount = SATsht.AutoFilter.Range.Columns(11).SpecialCells(xlCellTypeVisible).Cells.Count - 1
      
        'Update all the fields from SATfile to MARfile
        For X = 2 To SATCols
            On Error Resume Next
            Debug.Print SATsht.Cells(2, X)
            MARheader = Application.WorksheetFunction.Match(SATsht.Cells(2, X), MARheaderRng, 0)
            If Err.Number > 0 Then GoTo NextHeader
            On Error GoTo 0
          
            SATfile.Activate
            If AdditionsCount = 1 Then
                SATsht.Cells(3, X).Select 'PROBLEM IS HERE
            Else
                SATsht.Range(Cells(3, X), Cells(SATRows, X)).SpecialCells(xlCellTypeVisible).Select 'PROBLEM IS HERE
            End If
            'SATsht.Range(Cells(3, X), Cells(SATRows, X)).SpecialCells(xlCellTypeVisible).Select
            'SATsht.Range(Cells(3, X), Cells(SATRows, X)).SpecialCells(xlCellTypeVisible).Select
            Selection.Copy
            MARfile.Activate
            MARfile.Sheets(1).Cells(MARoldRows + 1, MARheader).PasteSpecial Paste:=xlPasteValues
          
NextHeader:
        Next
      
        MARnewRows = MARfile.Sheets(1).Range("C" & Rows.Count).End(xlUp).Row
      
        'Populate Dept as US F&A
        'MARfile.Sheets(1).Range("B" & MARoldRows + 1 & ":" & "B" & MARnewRows).Value = "US F&A"
        MARheader = Application.WorksheetFunction.Match("Department", MARheaderRng, 0)
        MARfile.Sheets(1).Cells(MARoldRows, MARheader).Select
        Selection.AutoFill Destination:=Range(Cells(MARoldRows, MARheader), Cells(MARnewRows, MARheader)), Type:=xlFillDefault
      
        'Populate Dept Code
        For X = MARoldRows + 1 To MARnewRows
            MARfile.Sheets(1).Range("D" & X).Value = Application.WorksheetFunction.VLookup(MARfile.Sheets(1).Range("C" & X), MARfile.Sheets("Reference").Range("A1:D30"), 2, 0)
        Next X
      
        'Populate Cost Center
        For X = MARoldRows + 1 To MARnewRows
            MARfile.Sheets(1).Range("E" & X).Value = Application.WorksheetFunction.VLookup(MARfile.Sheets(1).Range("C" & X), MARfile.Sheets("Reference").Range("A1:D30"), 3, 0)
        Next X
      
        'Populate SVP
        'With the help of reference
        'For X = MARoldRows + 1 To MARnewRows
        '    MARfile.Sheets(1).Range("F" & X).Value = Application.WorksheetFunction.VLookup(MARfile.Sheets(1).Range("D" & X), MARfile.Sheets("Reference").Range("A1:D30"), 4, 0)
        'Next X
      
        'Without Reference Sheet and directly dependent on SAT Column Number
        MARheader = Application.WorksheetFunction.Match("SVP", MARheaderRng, 0)
        SATfile.Activate
        SATsht.Range(Cells(3, 9), Cells(SATRows, 9)).SpecialCells(xlCellTypeVisible).Select
        Selection.Copy
        MARfile.Activate
        MARfile.Sheets(1).Cells(MARoldRows + 1, MARheader).PasteSpecial Paste:=xlPasteValues
      
        'Populate ActivityName
        MARheader = Application.WorksheetFunction.Match("Activity / Business Process Name", MARheaderRng, 0)
        SATfile.Activate
        SATsht.Range(Cells(3, 12), Cells(SATRows, 12)).SpecialCells(xlCellTypeVisible).Select
        Selection.Copy
        MARfile.Activate
        MARfile.Sheets(1).Cells(MARoldRows + 1, MARheader).PasteSpecial Paste:=xlPasteValues
        'Applying Trim in MAR
        Set MARrange = MARfile.Sheets(1).Range(Cells(2, MARheader), Cells(MARnewRows, MARheader))
        With MARrange
            .Value = Evaluate(Replace("If(@="""","""",Trim(@))", "@", .Address))
        End With
        'MARfile.Sheets(1).Range("I2:I" & MARnewRows).Value = Trim(MARfile.Sheets(1).Range("I2:I" & MARnewRows).Value)
      
        'Populate SubFunction/Process
        MARheader = Application.WorksheetFunction.Match("Sub-Process / Function", MARheaderRng, 0)
        SATfile.Activate
        SATsht.Range(Cells(3, 15), Cells(SATRows, 15)).SpecialCells(xlCellTypeVisible).Select
        Selection.Copy
        MARfile.Activate
        MARfile.Sheets(1).Cells(MARoldRows + 1, MARheader).PasteSpecial Paste:=xlPasteValues
      
        'Populate SubFunction Code
        'With the help of reference
        For X = MARoldRows + 1 To MARnewRows
            MARfile.Sheets(1).Range("L" & X).Value = Application.WorksheetFunction.VLookup(MARfile.Sheets(1).Range("K" & X), MARfile.Sheets("Reference").Range("F1:G30"), 2, 0)
        Next X
      
        ''Without Reference Sheet and directly dependent on SAT Column Number
        'MARheader = Application.WorksheetFunction.Match("Sub-Function Code", MARheaderRng, 0)
        'SATfile.Activate
        'SATfile.Sheets(1).Range(Cells(3, 9), Cells(SATRows, 9)).SpecialCells(xlCellTypeVisible).Select
        'Selection.Copy
        'MARfile.Activate
        'MARfile.Sheets(1).Cells(MARoldRows + 1, MARheader).PasteSpecial Paste:=xlPasteValues
      
        'Populate AHT
        MARheader = Application.WorksheetFunction.Match("Default AHT", MARheaderRng, 0)
        SATfile.Activate
        SATsht.Range(Cells(3, 20), Cells(SATRows, 20)).SpecialCells(xlCellTypeVisible).Select
        Selection.Copy
        MARfile.Activate
        MARfile.Sheets(1).Cells(MARoldRows + 1, MARheader).PasteSpecial Paste:=xlPasteValues
      
        'Populate Functional Playbook
        MARheader = Application.WorksheetFunction.Match("Functional Playbook", MARheaderRng, 0)
        SATfile.Activate
        SATsht.Range(Cells(3, 21), Cells(SATRows, 21)).SpecialCells(xlCellTypeVisible).Select
        Selection.Copy
        MARfile.Activate
        MARfile.Sheets(1).Cells(MARoldRows + 1, MARheader).PasteSpecial Paste:=xlPasteValues
      
        'MARheader = Application.WorksheetFunction.Match("Functional Playbook", MARheaderRng, 0)
        'MARfile.Sheets(1).Range(Cells(MARoldRows + 1, MARheader), Cells(MARnewRows, MARheader)).Value = "No"
      
        'Populate Backup 1,2,3
        MARheader = Application.WorksheetFunction.Match("Backup Team Member # 1", MARheaderRng, 0)
        SATfile.Activate
        SATsht.Range(Cells(3, 46), Cells(SATRows, 46)).Offset(0, 0).Resize(, 3).SpecialCells(xlCellTypeVisible).Select
        Selection.Copy
        MARfile.Activate
        MARfile.Sheets(1).Cells(MARoldRows + 1, MARheader).PasteSpecial Paste:=xlPasteValues
      
        'Populate Activity Recording URL
        MARheader = Application.WorksheetFunction.Match("Activity Recording URL", MARheaderRng, 0)
        SATfile.Activate
        SATsht.Range(Cells(3, 52), Cells(SATRows, 52)).SpecialCells(xlCellTypeVisible).Select
        Selection.Copy
        MARfile.Activate
        MARfile.Sheets(1).Cells(MARoldRows + 1, MARheader).PasteSpecial Paste:=xlPasteValues
      
        'MARheader = Application.WorksheetFunction.Match("Activity Recording URL", MARheaderRng, 0)
        'MARfile.Sheets(1).Range(Cells(MARoldRows + 1, MARheader), Cells(MARnewRows, MARheader)).Value = "-"
      
        'Populate Comments
        MARheader = Application.WorksheetFunction.Match("Comments", MARheaderRng, 0)
        MARfile.Sheets(1).Range(Cells(MARoldRows + 1, MARheader), Cells(MARnewRows, MARheader)).Value = "" & Format(Date, "mm/dd/yyyy") & ": Added as per the request received"
      
        'Autofill Sno.s
        MARheader = Application.WorksheetFunction.Match("S.No", MARheaderRng, 0)
        MARfile.Sheets(1).Cells(MARoldRows, MARheader).Select
        Selection.AutoFill Destination:=Range(Cells(MARoldRows, MARheader), Cells(MARnewRows, MARheader)), Type:=xlFillDefault
      
        'Autofill ActivityCode
        MARheader = Application.WorksheetFunction.Match("Activity Code", MARheaderRng, 0)
        MARfile.Sheets(1).Cells(MARoldRows, MARheader).Select
        Selection.AutoFill Destination:=Range(Cells(MARoldRows, MARheader), Cells(MARnewRows, MARheader)), Type:=xlFillDefault
      
        'Autofill Sub-Function Code
        MARheader = Application.WorksheetFunction.Match("Sub-Function Code", MARheaderRng, 0)
        MARfile.Sheets(1).Cells(MARoldRows, MARheader).Select
        Selection.AutoFill Destination:=Range(Cells(MARoldRows, MARheader), Cells(MARnewRows, MARheader)), Type:=xlFillDefault
      
        'Autofill WBS Charge Codes
        MARheader = Application.WorksheetFunction.Match("WBS Charge Code", MARheaderRng, 0)
        MARfile.Sheets(1).Cells(MARoldRows, MARheader).Select
        Selection.AutoFill Destination:=Range(Cells(MARoldRows, MARheader), Cells(MARnewRows, MARheader)), Type:=xlFillDefault
      
        'Apply all the borders
        MARfile.Sheets(1).Range(Cells(1, 1), Cells(MARnewRows, MARCols)).Borders.LineStyle = xlContinuous
      
        'Clear filters in MARfile
        On Error Resume Next
        MARfile.Sheets(1).ShowAllData
        On Error GoTo 0
      
        MARfile.Sheets("Macro").Activate
      
        'if there are any duplicates found, list out with MsgBox
        If DuplicateStr <> "" Then
            MsgBox "Following are the activities which are already been updated in MAR:" & vbNewLine & vbNewLine & DuplicateStr & vbNewLine & vbNewLine & "Please Cross-check, Thank you", vbExclamation + vbOKOnly, "Duplicate Activities"
        End If
      
        MsgBox "All the Activities have been successfully added to MAR file." & vbCrLf & vbCrLf & "Please Cross-check, Thank you", vbInformation + vbOKOnly, "New Transitioned Activities"
  
    ElseIf Z = 1 Then 'Deletion of Activity
      
        'On Error Resume Next
        'SATfile.Activate
        With SATsht
            .Activate
            .AutoFilterMode = False
            .Range(Cells(2, 1), Cells(SATRows, SATCols)).AutoFilter field:=2, Criteria1:="Deactivate Activity in the Master List"
        End With
      
        If SATsht.AutoFilter.Range.Columns(12).SpecialCells(xlCellTypeVisible).Cells.Count - 1 < 1 Then
            MsgBox "There are no activities under Deletions, please cross-check"
            GoTo NextMARFilter
            'Call Lock_HideAllSheets
            'SATfile.Close False
            'Exit Sub
        End If
        'On Error GoTo 0
      
      
        Set TotalRng = SATsht.Range(Cells(3, 12), Cells(SATRows, 12))
      
        MARfile.Sheets(1).AutoFilterMode = False
        For Each EachActivity In TotalRng.SpecialCells(xlCellTypeVisible)
            MARfile.Sheets(1).Activate
            If MARfile.Sheets(1).AutoFilterMode = False Then
                MARfile.Sheets(1).Range("A1").AutoFilter
            End If
            MARfile.Sheets(1).Range(Cells(1, MARCols), Cells(MARoldRows, MARCols)).AutoFilter field:=9, Criteria1:=EachActivity.Value
            If MARfile.Sheets(1).AutoFilter.Range.Columns(9).SpecialCells(xlCellTypeVisible).Cells.Count - 1 < 1 Then
                EachActivity.Font.Color = vbRed
                'MsgBox "There are no activities under Deletions, please cross-check"
                GoTo NextEachActivity
            End If
            'Debug.Print .Offset(0, 42).SpecialCells(xlCellTypeVisible).Areas(1).Rows(2).Address
            'MARfile.Sheets(1).Range(Cells(1, 9), Cells(MARoldRows, 9)).Offset(0, 41).SpecialCells(xlCellTypeVisible).Areas(1).Rows(2).Value = "Inactive"
            MARfile.Sheets(1).Range(Cells(1, 9).Offset(1), Cells(MARoldRows, 9)).SpecialCells(xlCellTypeVisible).Cells(1, 42).Value = "Inactive"
NextEachActivity:
            MARfile.Sheets(1).ShowAllData
        Next
        ModificationsCount = TotalRng.SpecialCells(xlCellTypeVisible).Rows.Count
      
    ElseIf Z = 2 Then 'Modify the Activity
  
        Set MDsht = MARfile.Sheets("Modified & Deleted Activities")
        MDrows = MDsht.Range("A" & Rows.Count).End(xlUp).Row
        MDcols = MDsht.Cells(657, Columns.Count).End(xlToLeft).Column
          
        With SATsht
            .Activate
            .AutoFilterMode = False
            .Range(Cells(2, 1), Cells(SATRows, SATCols)).AutoFilter field:=2, Criteria1:="Modify exisiting activity level details"
        End With
      
        If SATsht.AutoFilter.Range.Columns(12).SpecialCells(xlCellTypeVisible).Cells.Count - 1 < 1 Then
            MsgBox "There are no activities under Deletions, please cross-check"
            GoTo NextMARFilter
            'Call Lock_HideAllSheets
            'SATfile.Close False
            'Exit Sub
        End If
      
        Set TotalRng = SATsht.Range(Cells(3, 12), Cells(SATRows, 12))
      
        MARfile.Sheets(1).AutoFilterMode = False
        MARoldRows = MARfile.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
      
        For Each EachActivity In TotalRng.SpecialCells(xlCellTypeVisible)
      
            MARfile.Sheets(1).Activate
            If MARfile.Sheets(1).AutoFilterMode = False Then
                MARfile.Sheets(1).Range("A1").AutoFilter
            End If
            MARfile.Sheets(1).Range(Cells(1, MARCols), Cells(MARoldRows, MARCols)).AutoFilter field:=9, Criteria1:=EachActivity.Value
            If MARfile.Sheets(1).AutoFilter.Range.Columns(9).SpecialCells(xlCellTypeVisible).Cells.Count - 1 < 1 Then
                EachActivity.Font.Color = vbRed
                'MsgBox "There are no activities under Deletions, please cross-check"
                GoTo NextEachActivity1
            End If
          
            'MARfile.Sheets(1).Range(Cells(1, 9).Offset(1), Cells(MARoldRows, 9)).SpecialCells(xlCellTypeVisible).Cells(1, 42).Value = "Inactive"
          
            'Copy the data from MAR Main Sheet to "Deletions and Modifications" sheet and delete the data in MAR Main Sheet
            MARfile.Sheets(1).Range(Cells(1, "B").Offset(1), Cells(MARoldRows, "H")).SpecialCells(xlCellTypeVisible).Areas(1).Rows(1).Copy
            MDsht.Cells(MDrows + 1, "D").PasteSpecial xlPasteValues
          
            MARfile.Sheets(1).Range(Cells(1, "I").Offset(1), Cells(MARoldRows, "AX")).SpecialCells(xlCellTypeVisible).Areas(1).Rows(1).Copy
            MDsht.Cells(MDrows + 1, "L").PasteSpecial xlPasteValues
          
            MDsht.Range("A" & MDrows + 1).Value = MDrows + 1 'SNos
            MDsht.Range("C" & MDrows + 1).Value = "Modify exisiting activity level details" 'Request Type
            MDsht.Cells(MDrows + 1, "BB").Value = Date & ": Modified as per the request received"
          
            MDrows = MDsht.Range("A" & Rows.Count).End(xlUp).Row
          
            MARfile.Sheets(1).Range(Cells(1, "B").Offset(1), Cells(MARoldRows, "H")).SpecialCells(xlCellTypeVisible).Areas(1).Rows(1).Select
            Selection.EntireRow.Delete xlUp
          
            'Copy the data from SAT Sheet to MAR Main sheet
            If MARfile.Sheets(1).AutoFilterMode = True Then
                MARfile.Sheets(1).ShowAllData
            Else
                MARfile.Sheets(1).AutoFilter
            End If
          
            MARnewRows = MARfile.Sheets(1).Range("B" & Rows.Count).End(xlUp).Row
          
            SATfile.Activate
            'If EachActivity.Offset(0, 1).Value <> "-" Or Not (EachActivity.Offset(0, 1).Value Like "") Then
            If EachActivity.Offset(0, 1).Value <> "-" Or EachActivity.Offset(0, 1).Value = "" Then
                'EachActivity.Resize(, -7).Select 'Copy
                SATsht.Range(Cells(EachActivity.Row, "E"), Cells(EachActivity.Row, "K")).Copy
                MARfile.Sheets(1).Range("B" & MARnewRows + 1).PasteSpecial xlPasteValues
              
                SATsht.Range(Cells(EachActivity.Row, "M"), Cells(EachActivity.Row, "R")).Copy
                MARfile.Sheets(1).Range("I" & MARnewRows + 1).PasteSpecial xlPasteValues
              
                SATsht.Range(Cells(EachActivity.Row, "S"), Cells(EachActivity.Row, "BA")).Copy
                MARfile.Sheets(1).Range("P" & MARnewRows + 1).PasteSpecial xlPasteValues
            Else
                SATsht.Range(Cells(EachActivity.Row, "E"), Cells(EachActivity.Row, "L")).Copy
                MARfile.Sheets(1).Range("B" & MARnewRows + 1).PasteSpecial xlPasteValues
              
                SATsht.Range(Cells(EachActivity.Row, "N"), Cells(EachActivity.Row, "R")).Copy
                MARfile.Sheets(1).Range("J" & MARnewRows + 1).PasteSpecial xlPasteValues
              
                SATsht.Range(Cells(EachActivity.Row, "S"), Cells(EachActivity.Row, "BA")).Copy
                MARfile.Sheets(1).Range("P" & MARnewRows + 1).PasteSpecial xlPasteValues
            End If
          
NextEachActivity1:
            MARfile.Sheets(1).Activate
            On Error Resume Next
            MARfile.Sheets(1).ShowAllData
            On Error GoTo 0
        Next
          
            MARoldRows = MARfile.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
            MARnewRows = MARfile.Sheets(1).Range("B" & Rows.Count).End(xlUp).Row
            'Populate Dept Code
            For X = MARoldRows + 1 To MARnewRows
                MARfile.Sheets(1).Range("D" & X).Value = Application.WorksheetFunction.VLookup(MARfile.Sheets(1).Range("C" & X), MARfile.Sheets("Reference").Range("A1:D30"), 2, 0)
            Next X
          
            'Populate Cost Center
            For X = MARoldRows + 1 To MARnewRows
                MARfile.Sheets(1).Range("E" & X).Value = Application.WorksheetFunction.VLookup(MARfile.Sheets(1).Range("C" & X), MARfile.Sheets("Reference").Range("A1:D30"), 3, 0)
            Next X
          
            'Populate Comments
            MARheader = Application.WorksheetFunction.Match("Comments", MARheaderRng, 0)
            MARfile.Sheets(1).Range(Cells(MARoldRows + 1, MARheader), Cells(MARnewRows, MARheader)).Value = "" & Format(Date, "mm/dd/yyyy") & ": Modified as per the request received"
          
            'Autofill Sno.s
            MARheader = Application.WorksheetFunction.Match("S.No", MARheaderRng, 0)
            MARfile.Sheets(1).Cells(MARoldRows, MARheader).Select
            Selection.AutoFill Destination:=Range(Cells(MARoldRows, MARheader), Cells(MARnewRows, MARheader)), Type:=xlFillDefault
          
            'Autofill ActivityCode
            MARheader = Application.WorksheetFunction.Match("Activity Code", MARheaderRng, 0)
            MARfile.Sheets(1).Cells(MARoldRows, MARheader).Select
            Selection.AutoFill Destination:=Range(Cells(MARoldRows, MARheader), Cells(MARnewRows, MARheader)), Type:=xlFillDefault
          
            'Autofill Sub-Function Code
            MARheader = Application.WorksheetFunction.Match("Sub-Function Code", MARheaderRng, 0)
            MARfile.Sheets(1).Cells(MARoldRows, MARheader).Select
            Selection.AutoFill Destination:=Range(Cells(MARoldRows, MARheader), Cells(MARnewRows, MARheader)), Type:=xlFillDefault
          
            'Autofill WBS Charge Codes
            MARheader = Application.WorksheetFunction.Match("WBS Charge Code", MARheaderRng, 0)
            MARfile.Sheets(1).Cells(MARoldRows, MARheader).Select
            Selection.AutoFill Destination:=Range(Cells(MARoldRows, MARheader), Cells(MARnewRows, MARheader)), Type:=xlFillDefault
          
            'Apply all the borders
            MARfile.Sheets(1).Range(Cells(1, 1), Cells(MARnewRows, MARCols)).Borders.LineStyle = xlContinuous
          
            'Clear filters in MARfile
            On Error Resume Next
            MARfile.Sheets(1).ShowAllData
            On Error GoTo 0
  
    End If
  
NextMARFilter:
Next Z

MsgBox "Activities have been Added/Modified as per the requirements." & vbNewLine & vbNewLine & _
       "Any activity that is highlighted in RED in Standard Template represent the following:" & vbCrLf & vbCrLf & _
        "1. Addtions: Activities that are already available" & vbNewLine & _
        "2. Modifications: Activities are not available to modify." & vbNewLine & _
        "3. Deletions: Activities are not available to delete." & vbNewLine & vbNewLine & _
        "Please cross-check, Thank you.", vbInformation + vbOKOnly, "MAR Modifications"

End Sub

Appreciate your help in advance.
 
Upvote 0
I'm just guessing here, just add the blue line:
Rich (BB code): 
            SATfile.Activate
            If SATRows < 3 Then SATRows = 3  
            SATsht.Range(Cells(3, X), Cells(SATRows, X)).SpecialCells(xlCellTypeVisible).Select 'PROBLEM IS HERE
            Selection.Copy
            MARfile.Activate
            MARfile.Sheets(1).Cells(MARoldRows + 1, MARheader).PasteSpecial Paste:=xlPasteValues
If that doesn't work, could you upload a sample workbook (without sensitive data) to a sharing site like dropbox.com or google drive?
And then share the link here.
 
Upvote 0
Akuini said:
I'm just guessing here, just add the blue line:
Rich (BB code): 
            SATfile.Activate
           If SATRows < 3 Then SATRows = 3  
            SATsht.Range(Cells(3, X), Cells(SATRows, X)).SpecialCells(xlCellTypeVisible).Select 'PROBLEM IS HERE
            Selection.Copy
            MARfile.Activate
            MARfile.Sheets(1).Cells(MARoldRows + 1, MARheader).PasteSpecial Paste:=xlPasteValues
If that doesn't work, could you upload a sample workbook (without sensitive data) to a sharing site like dropbox.com or google drive?
And then share the link here.
Click to expand...
Sure @Akuini I'll try this and if that does not work, I'll try to figure out and try to upload blank files without sensitive data here, for your reference.
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Question Question
Macro to Copy Values from Non-Contiguous Cells (Column) to Contiguous Cells (Rows)
Replies
3
Views
115
mumps
mumps
J
  • Solved
VBA Code To Select Both Contiguous & Non-Contiguous Columns
Replies
6
Views
330
Peter_SSs
Peter_SSs
B
  • Question Question
Count number of contiguous equal cells
Replies
4
Views
130
Belthazar
B
F
  • Question Question
Test for non contiguous range
Replies
7
Views
500
Formula11
F
B
  • Solved
VBA Copy adjacent AND non-adjacent named table columns
Replies
2
Views
274
Bleed_Air
B

Forum statistics

Threads
1,224,812
Messages
6,181,083
Members
453,021
Latest member
Justyna P

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