Hi,
I am using a more elaborate code in a workbook to refresh data from a webquery and then execute some simple tasks like copying and editing. Please see code below which is working well:
Now, instead of copying a fixed range, i would like the macro to copy only the filtered rows (filtering for values =1, filter is always applied in column B). Therefore i replaced this part of the code:
with this:
It worked fine in a simple test workbook, but when i substitute into the complete code as above it gives a runtime 1004 error (see attchment).
What am i doing wrong? And is there maybe a simpler way to only select an autofilterd range?
thanks a lot for your thoughts!
Valentino
I am using a more elaborate code in a workbook to refresh data from a webquery and then execute some simple tasks like copying and editing. Please see code below which is working well:
SQL:
Private Sub Worksheet_Calculate()
'
' V2.1
'
' 1st 10 minute refresh will create the DestinationSheet if it doesn't exist & will save the conditions column results to create a base line to compare to.
' All other 10 minute refreshes will compare the current condition columns to the previous condition columns and display the Assets that had
' conditions changed to '1' or '-1'
'
' Check the lines at the top of the script that end with ' <---
' Those lines are the lines that may need to be changed to reflect your particular setup.
'
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
Dim CurrentConditionsStartRow As Long, LastRowAssetColummn As Long
Dim CurrentConditionsRange As Range
Dim DestinationSheet As String
Dim AssetColumn As String, StatusColumn As String
Dim FirstConditionColumn As String, SecondConditionColumn As String
Dim ConditionsCombinedColumn As String
Dim wsDestination As Worksheet, wsSource As Worksheet
'
DestinationSheet = "TenMinuteUpdates" ' <--- Set this to the name of the sheet to store 10 minute results into
Set wsSource = ThisWorkbook.Sheets("Sheet1") ' <--- Set this to the sheetname that has the '1's & '0's
'
AssetColumn = "A" ' <--- Set this to the Asset Column letter, this column is used to determine last row
StatusColumn = "B" ' <--- Set this to the column letter of the StatusColumn
FirstConditionColumn = "C" ' <--- Set this to the column letter of the first condition
SecondConditionColumn = "D" ' <--- Set this to the column letter of the second condition
ConditionsCombinedColumn = "E" ' <--- Set this to the column letter of the ConditionsCombined Column
CurrentConditionsStartRow = 2 ' <--- Set this to the start row of CurrentConditions
'
LastRowAssetColummn = wsSource.Range(AssetColumn & _
Rows.Count).End(xlUp).Row ' Determine last row of data
'
Set CurrentConditionsRange = wsSource.Range(FirstConditionColumn & _
CurrentConditionsStartRow & ":" & SecondConditionColumn & _
LastRowAssetColummn) ' Establish the ConditionsRange
'
If Application.CountIf(CurrentConditionsRange, "1") > 0 Or _
Application.CountIf(CurrentConditionsRange, "-1") > 0 Then ' If the ConditionsRange contains any value of 1 or -1 then ...
'
Dim ArrayRowIncremented As Boolean, DestinationSheetExists As Boolean
Dim ConditionsColumnColumn As Long, ConditionsColumnRow As Long
Dim CurrentConditionValue As Long
Dim LastDestinationColumnNumber As Long
Dim OutputArrayRow As Long
'
Dim AssetColumnArray As Variant, CurrentConditionsArray As Variant
Dim DateTimeArray(1 To 2) As Variant
Dim PreviousConditionsArray As Variant, PreviousHeadingsArray(1 To 3) As Variant
Dim OutputArray As Variant, SourceArray As Variant
'
On Error Resume Next ' Bypass error generated in next line if sheet does not exist
Set wsDestination = ThisWorkbook.Sheets(DestinationSheet) ' Assign DestinationSheet to wsDestination
On Error GoTo 0 ' Turn Excel error handling back on
'
If Not wsDestination Is Nothing Then DestinationSheetExists = True ' Check to see if the DestinationSheet exists
'
' Create DestinationSheet if it doesn't exist
If DestinationSheetExists = False Then ' If DestinationSheet does not exist then ...
ThisWorkbook.Sheets.Add(after:=wsSource).Name = DestinationSheet ' Create the DestinationSheet after the Source sheet
Set wsDestination = ThisWorkbook.Sheets(DestinationSheet) ' Assign the DestinationSheet to wsDestination
End If
'
' Load current Conditions into array
CurrentConditionsArray = CurrentConditionsRange ' Load the values of the Condition Columns range into the 2D 1 based
' ' ConditionsArray RC
ReDim OutputArray(1 To UBound(CurrentConditionsArray)) ' Establish # of rows in 1D 1 based OutputArray
'
SourceArray = wsSource.Range(AssetColumn & CurrentConditionsStartRow & _
":" & ConditionsCombinedColumn & LastRowAssetColummn) ' Load all source values into SourceArray
'
' Create Saved conditions result columns on DestinationSheet if they haven't been created yet
If wsDestination.Range("A1") = vbNullString Then ' If previous conditions have not been saved then ...
PreviousHeadingsArray(1) = Date ' Save Date into PreviousHeadingsArray
PreviousHeadingsArray(2) = Time() ' Save Time into PreviousHeadingsArray
PreviousHeadingsArray(3) = "------------------" ' Save space line into PreviousHeadingsArray
wsDestination.Range("A1").Resize(UBound(PreviousHeadingsArray, 1)) _
= Application.Transpose(PreviousHeadingsArray) ' Save PreviousHeadingsArray to destination sheet
'
wsDestination.Range("A4").Resize(UBound(CurrentConditionsArray, 1), _
UBound(CurrentConditionsArray, 2)) = CurrentConditionsArray ' Display CurrentConditionsArray to DestinationSheet
'
wsDestination.UsedRange.EntireColumn.AutoFit ' Autofit all of the columns
'
GoTo SubExit ' Exit this subroutine
End If
'
' Load previous conditions results into array
PreviousConditionsArray = wsDestination.Range("A4:B" & _
wsDestination.Range("A" & Rows.Count).End(xlUp).Row) ' Load previous conditions results into PreviousConditionsArray
' ' AssetColumnArray RC
'-------------------------------------------------------------------
'
' Find and save changes from zero
OutputArrayRow = 0 ' Initialize OutputArrayRow to zero
'
For ConditionsColumnRow = 1 To UBound(CurrentConditionsArray, 1) ' Loop through the CurrentConditionsArray rows to check for '1's & '-1's
For ConditionsColumnColumn = 1 To UBound(CurrentConditionsArray, 2) ' Loop through the CurrentConditionsArray columns to check for '1's & '-1's
'
CurrentConditionValue = CurrentConditionsArray(ConditionsColumnRow, _
ConditionsColumnColumn) ' Get the CurrentConditionValue
'
If CurrentConditionValue = "1" Or CurrentConditionValue = "-1" Then ' If a '1' or '-1' is found then ...
'
If PreviousConditionsArray(ConditionsColumnRow, _
ConditionsColumnColumn) = 0 Then ' If previous value was '0' then ...
If ArrayRowIncremented = False Then ' If we haven't already incremented OutputArrayRow then ...
OutputArrayRow = OutputArrayRow + 1 ' Increment OutputArrayRow
ArrayRowIncremented = True ' Set ArrayRowIncremented flag = True
End If
'
If OutputArray(OutputArrayRow) = vbNullString Then ' If OutputArray cell is blank then ...
OutputArray(OutputArrayRow) = "(" & _
SourceArray(ConditionsColumnRow, 5) & ") " & _
SourceArray(ConditionsColumnRow, 1) & " " & _
SourceArray(ConditionsColumnRow, 2) ' Save desired result to OutputArray
End If
End If
End If
Next ' Loop Back
'
ArrayRowIncremented = False ' Reset the ArrayRowIncremented to False
Next ' Loop Back
'
'-------------------------------------------------------------------
'
' Save found changes to the DestinationSheet
LastDestinationColumnNumber = wsDestination.Cells.Find("*", _
, xlFormulas, , xlByColumns, xlPrevious).Column ' Get last Column Number used in the DestinationSheet
'
DateTimeArray(1) = Date
DateTimeArray(2) = Time()
wsDestination.Cells(1, LastDestinationColumnNumber + _
1).Resize(UBound(DateTimeArray, 1)) = _
Application.Transpose(DateTimeArray) ' Display Date & Time to Destination sheet
'
wsDestination.Cells(4, LastDestinationColumnNumber _
+ 1).Resize(UBound(OutputArray)) = _
Application.Transpose(OutputArray) ' Display results to DestinationSheet
'
'-------------------------------------------------------------------
'
'Save ConditionsArray to the DestinationSheet
wsDestination.Range("A1").Resize(UBound(DateTimeArray, 1)) _
= Application.Transpose(DateTimeArray) ' Display Date & Time to destination sheet
'
wsDestination.Range("A4").Resize(UBound(CurrentConditionsArray, 1), _
UBound(CurrentConditionsArray, 2)) = CurrentConditionsArray ' Display results to DestinationSheet
'
wsDestination.UsedRange.EntireColumn.AutoFit ' Autofit all of the columns
End If
'
'-------------------------------------------------------------------
SubExit:
Sheets("Historical").Range("b1:c101").EntireColumn.Insert
Sheets("Historical").Range("b1:c101").Value = Sheets("Daily").Range("Aj1:Ak101").Value
Sheets("Historical").Range("sl1:sz101").EntireColumn.Delete
Application.Goto Sheets("Historical").Range("a1")
Sheets("DatasheetSelfData").Range("a1:is101").Value = Sheets("DatasheetSelf").Range("A1:is101").Value
Sheets("DatasheetSelfData").Range("jc108:je208").Value = Sheets("DatasheetSelfData").Range("iu108:iw208").Value
Sheets("MSBSelf").Range("cd1:cd101").Value = Sheets("MSBSelf").Range("cb1:cb101").Value
Sheets("TenMinuteUpdates").Range("A4", Sheets("TenMinuteUpdates").Range("A4").End(xlDown)) = 0
Application.Goto Sheets("TenMinuteUpdates").Range("a1")
Application.EnableEvents = True
Application.ScreenUpdating = True
End SubNow, instead of copying a fixed range, i would like the macro to copy only the filtered rows (filtering for values =1, filter is always applied in column B). Therefore i replaced this part of the code:
SQL:
Sheets("Historical").Range("b1:c101").Value = Sheets("Daily").Range("Aj1:Ak101").Valuewith this:
SQL:
Application.Goto Sheets("Daily").Range("aj1")
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Historical").Select
Range("b1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=FalseIt worked fine in a simple test workbook, but when i substitute into the complete code as above it gives a runtime 1004 error (see attchment).
What am i doing wrong? And is there maybe a simpler way to only select an autofilterd range?
thanks a lot for your thoughts!
Valentino
