new2code
10-07-2016, 12:05 PM
Hello All,
In a nutshell, I'm trying to filter one column ("Emp Cont Type") for two values ("Regular" and "Term"), and then have those values copied over to a second column ("Employment Type Indicator"), for the exact same set of filtered data.
Now, we all know that doing a straight "copy and paste" of filtered data does/will not work.
So, I found out that one way to achieve the required results is as follows:
• Apply the required filter
• Select the entire source column
• Then select the target column
• Then perform a "Fill Right" or "Fill Left" depending on which side the target column lies
My code below is doing exactly the above, however I find that when I run the code from a sheet "other than the one that contains the data" it bombs out with a "Runtime error 424 - Object required". The error message is against the line:
Set rngToCopy = .Range(colLetter & "2:" & colLetter & lastRow)
On the other hand, if I physically activate/select the data sheet and run the code it works just fine (no error, and data gets copied across correctly)
What I do want to achieve is to have the end-user click a button from a menu and have the code do its job (transparent to the user/in the background)...without the user having to see that a data sheet is being selected, and all kinds of things happening to the data on that sheet, and then being returned to the "menu" sheet.
Is there any way I can either fix the error, or perhaps even achieve my desired result a different way? Perhaps I'm over-complicating things!
Thanks.
Sub syncTwoColumns()
Dim i, columnCount As Integer
Dim aCell1, aCell2, aCell3 As Range
Dim col1, col2, col3 As Long, Lrow As Long
Dim ColName1, ColName2, ColName3 As String
Dim colNumber1, colNumber2, colNumber3 As Integer
Dim colNumber As Integer
Dim colLetter As String
Dim rngToCopy, rngToUpdate, unionedRange As Range
Dim SearchRng As Range, myCell As Range
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Sheet1")
Dim lastRow, lastColumnNumber As Long
lastRow = ActiveSheet.UsedRange.Rows.Count
lastColumnNumber = ws.Cells(1, Columns.Count).End(xlToLeft).Column
Dim lastColumnLetter As String
lastColumnLetter = ReturnName(lastColumnNumber)
On Error Resume Next
ws.Range("A1:" & lastColumnLetter & "1").SpecialCells(xlCellTypeBlanks).Value = "*** TEMP ***"
On Error GoTo 0
With ws
.Range("A1").AutoFilter
Set SearchRng = .Range("A1:" & lastColumnLetter & "1")
For Each myCell In SearchRng
If InStr(1, UCase(myCell.Value), UCase("emp cont type")) > 0 Then
colLetter = Split(myCell.Address(1, 0), "$")(0)
colNumber1 = wColNum(colLetter) '<-- Call function to return Column Number of found cell
' Now filtering on the column
.UsedRange.AutoFilter field:=colNumber1, Criteria1:= _
"=Regular Seasonal", Operator:=xlOr, Criteria2:="=Term PWU Referral"
Set rngToCopy = .Range(colLetter & "2:" & colLetter & lastRow)
Exit For
End If
Next myCell
For Each myCell In SearchRng
If InStr(1, UCase(myCell.Value), UCase("employment type indicator")) > 0 Then
colLetter = Split(myCell.Address(1, 0), "$")(0)
colNumber1 = wColNum(colLetter) '<-- Call function to return Column Number of found cell
Exit For
End If
Next myCell
On Error Resume Next
Set rngToUpdate = .Range(colLetter & "2:" & colLetter & lastRow)
On Error GoTo 0
'--------------------------------------------------------------------------
' Setting and selecting the two non-contiguous cell ranges,
' and then copying the filtered contents over from column named "emp cont type" to
' column named "employment type indicator"
If unionedRange Is Nothing Then
Set unionedRange = Union(rngToCopy, rngToUpdate)
End If
unionedRange.FillRight ' This (FillRight) is a hack/work-around to copying/pasting from-and-to a filtered list, which doesn't work
'''unionedRange.Select
'''Selection.FillRight ' This is a hack/work-around to copying/pasting from-and-to a filtered list, which doesn't work
Range("A1").Select
.ShowAllData
End With
' Call settingsON
End Sub
In a nutshell, I'm trying to filter one column ("Emp Cont Type") for two values ("Regular" and "Term"), and then have those values copied over to a second column ("Employment Type Indicator"), for the exact same set of filtered data.
Now, we all know that doing a straight "copy and paste" of filtered data does/will not work.
So, I found out that one way to achieve the required results is as follows:
• Apply the required filter
• Select the entire source column
• Then select the target column
• Then perform a "Fill Right" or "Fill Left" depending on which side the target column lies
My code below is doing exactly the above, however I find that when I run the code from a sheet "other than the one that contains the data" it bombs out with a "Runtime error 424 - Object required". The error message is against the line:
Set rngToCopy = .Range(colLetter & "2:" & colLetter & lastRow)
On the other hand, if I physically activate/select the data sheet and run the code it works just fine (no error, and data gets copied across correctly)
What I do want to achieve is to have the end-user click a button from a menu and have the code do its job (transparent to the user/in the background)...without the user having to see that a data sheet is being selected, and all kinds of things happening to the data on that sheet, and then being returned to the "menu" sheet.
Is there any way I can either fix the error, or perhaps even achieve my desired result a different way? Perhaps I'm over-complicating things!
Thanks.
Sub syncTwoColumns()
Dim i, columnCount As Integer
Dim aCell1, aCell2, aCell3 As Range
Dim col1, col2, col3 As Long, Lrow As Long
Dim ColName1, ColName2, ColName3 As String
Dim colNumber1, colNumber2, colNumber3 As Integer
Dim colNumber As Integer
Dim colLetter As String
Dim rngToCopy, rngToUpdate, unionedRange As Range
Dim SearchRng As Range, myCell As Range
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Sheet1")
Dim lastRow, lastColumnNumber As Long
lastRow = ActiveSheet.UsedRange.Rows.Count
lastColumnNumber = ws.Cells(1, Columns.Count).End(xlToLeft).Column
Dim lastColumnLetter As String
lastColumnLetter = ReturnName(lastColumnNumber)
On Error Resume Next
ws.Range("A1:" & lastColumnLetter & "1").SpecialCells(xlCellTypeBlanks).Value = "*** TEMP ***"
On Error GoTo 0
With ws
.Range("A1").AutoFilter
Set SearchRng = .Range("A1:" & lastColumnLetter & "1")
For Each myCell In SearchRng
If InStr(1, UCase(myCell.Value), UCase("emp cont type")) > 0 Then
colLetter = Split(myCell.Address(1, 0), "$")(0)
colNumber1 = wColNum(colLetter) '<-- Call function to return Column Number of found cell
' Now filtering on the column
.UsedRange.AutoFilter field:=colNumber1, Criteria1:= _
"=Regular Seasonal", Operator:=xlOr, Criteria2:="=Term PWU Referral"
Set rngToCopy = .Range(colLetter & "2:" & colLetter & lastRow)
Exit For
End If
Next myCell
For Each myCell In SearchRng
If InStr(1, UCase(myCell.Value), UCase("employment type indicator")) > 0 Then
colLetter = Split(myCell.Address(1, 0), "$")(0)
colNumber1 = wColNum(colLetter) '<-- Call function to return Column Number of found cell
Exit For
End If
Next myCell
On Error Resume Next
Set rngToUpdate = .Range(colLetter & "2:" & colLetter & lastRow)
On Error GoTo 0
'--------------------------------------------------------------------------
' Setting and selecting the two non-contiguous cell ranges,
' and then copying the filtered contents over from column named "emp cont type" to
' column named "employment type indicator"
If unionedRange Is Nothing Then
Set unionedRange = Union(rngToCopy, rngToUpdate)
End If
unionedRange.FillRight ' This (FillRight) is a hack/work-around to copying/pasting from-and-to a filtered list, which doesn't work
'''unionedRange.Select
'''Selection.FillRight ' This is a hack/work-around to copying/pasting from-and-to a filtered list, which doesn't work
Range("A1").Select
.ShowAllData
End With
' Call settingsON
End Sub