error message, probably by not defining things :/

Ammers93

New Member
Joined
Mar 25, 2017
Messages
4
Hi,

i have this code for converting a webpge into an excel document, then i can apply a bunch of autofilters on the copied data to manipulate it...i am fairly new to VBA, but using this project as a way to learn it...

i have an issue with warning messages....the one at the moment is with when i am defining last row.....originally there was one lastrow dimension, but created 2, 1 for each sheet, as that was giving me an error. that error then dissappeared and replaced it with

"object variable or with block variable not set"

i have 2 sheets, both named as sheets, and as VBA objects as SI and TR (this way i don't have to keep writing sheets("SI") everytime), SI is where the raw webpage goes to to get converted, then i extract the filtered data, paste it into the sheet TR which is the cover, and will e used by people....code is as follows:

Code:
[/COLOR][COLOR=#333333]Sub filter_test()[/COLOR]
<code style="margin: 0px; padding: 0px; font-style: inherit; font-weight: inherit; line-height: 12px;">
Application.ScreenUpdating = False

SI.Visible = True

        
'all dimensions
        
        Dim FilterStartDate As Date, FilterEndDate As Date
        Dim lastrowsi As Long
        Dim lastrowtr As Long
        Dim FilterRange As Range
        Dim trdrng As Range
        Dim TRFRng As Range
        Dim sh As Shape
        Dim paidOUTrng As Range
        Dim paidINrng As Range
       
        
'all range sets

        Set trdrng = TR.Range("A" & (lastrowttr + 1))
        Set TRFRng = TR.Range("a" & (lastrowtr + 1) & ":f" & (lastrowtr + 1))

          
        
SI.Activate

    SI.Cells.Delete
    
        SI.Range("A1").PasteSpecial
        
        ActiveWindow.ScrollRow = 1
        ActiveWindow.ScrollColumn = 1
    
        ActiveSheet.paste
        Application.CutCopyMode = False
    

' delete first 4 columns
    SI.Columns("A:D").EntireColumn.Delete
 
'unmerge all cells
 
    SI.Cells.UnMerge
 
 'delete all shapes
 
    
    For Each sh In SI.Shapes
    sh.Delete
    Next sh
 
 
'delete last columns
 
    SI.Columns("G:L").EntireColumn.Delete
    
'autofilter all useful data by dates
          With SI
                lastrowsi = Cells.Find(What:="*", After:=Range("A1"), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
          End With
            With TR
                lastrowtr = Cells.Find(What:="*", After:=Range("A1"), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            End With
        Set FilterRange = SI.Range("A1:f" & lastrowsi)
        FilterStartDate = TR.Range("tDate").Value
        FilterEndDate = TR.Range("dfltedate").Value

        FilterRange.AutoFilter field:=1, Criteria1:="<" & CDbl(FilterStartDate), _
        Operator:=xlAnd, Criteria2:=">" & CDbl(FilterEndDate)
        
'copy usefull data to main spreadsheet under active stuff
       
        ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible).Copy _
        Destination:=TR.Range("A" & (lastrowtr + 1))

TR.Activate


'delete all blank rows in column 2
    
   
    TRFRng.AutoFilter field:=3, Criteria1:="="
    TRFRng.SpecialCells _
    (xlCellTypeVisible).EntireRow.Delete
    
'subtotal formulas
    Set paidOUTrng = TR.Range("d9:d" & lastrowtr)
    Set paidINrng = TR.Range("E9:E" & lastrowtr)
    paidOUTrng.Name = "PaidOUT"
    paidINrng.Name = "PaidIN"
    
    
    TR.Range("D3").Formula = "=subtotal(9,(PaidOUT)"
    TR.Range("E3").Formula = "=subtotal(9,(PaidIN))"
    TR.AutoFilterMode = False


'apply autofilter

    TRFRng.AutoFilter

SI.Visible = False
Application.ScreenUpdating = True
 </code>[COLOR=#333333]End Sub[/COLOR][COLOR=#333333]


I've already been advised that i haven't put in Dim SI as Worksheet, and after "set SI = sheets("SI") for both sheets respectively, however when i added these it comes up with another error saying "duplicate declaration in current scope"

If anyone can help it would be much appreciated. This needs to work on excel 2010, but I created the sheet on excel 2013 (I use 2010 at work but 2013 at home. due to my job I can't take my stuff home)

:)
 

Excel Facts

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college
Does this work for you....you didn't dimm the worksheets NOR did you set them....so excel didn't know what SI actually represented
AND
you can't select an entire sheet and DELETE all cells....you can clear them instead.

Code:
Sub filter_test()
'all dimensions
        
        Dim FilterStartDate As Date, FilterEndDate As Date
        Dim lastrowsi As Long
        Dim lastrowtr As Long
        Dim FilterRange As Range
        Dim trdrng As Range
        Dim TRFRng As Range
        Dim sh As Shape
        Dim paidOUTrng As Range
        Dim paidINrng As Range
        Dim SI As Worksheet, TR As Worksheet
Application.ScreenUpdating = False
Set SI = Sheets("SI")
Set TR = Sheets("TR")
SI.Visible = True
'all range sets

        Set trdrng = TR.Range("A" & (lastrowttr + 1))
        Set TRFRng = TR.Range("a" & (lastrowtr + 1) & ":f" & (lastrowtr + 1))
SI.Activate
    SI.Cells.Clear
        SI.Range("A1").PasteSpecial
        ActiveSheet.Paste
        Application.CutCopyMode = False
' delete first 4 columns
    SI.Columns("A:D").EntireColumn.Delete
'unmerge all cells
    SI.Cells.UnMerge
 'delete all shapes
    For Each sh In SI.Shapes
    sh.Delete
    Next sh
'delete last columns
    SI.Columns("G:L").EntireColumn.Delete
'autofilter all useful data by dates
          With SI
                lastrowsi = Cells.Find(What:="*", After:=Range("A1"), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
          End With
            With TR
                lastrowtr = Cells.Find(What:="*", After:=Range("A1"), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            End With
        Set FilterRange = SI.Range("A1:f" & lastrowsi)
        FilterStartDate = TR.Range("tDate").Value
        FilterEndDate = TR.Range("dfltedate").Value

        FilterRange.AutoFilter field:=1, Criteria1:="<" & CDbl(FilterStartDate), _
        Operator:=xlAnd, Criteria2:=">" & CDbl(FilterEndDate)
'copy usefull data to main spreadsheet under active stuff
       
        ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible).Copy _
        Destination:=TR.Range("A" & (lastrowtr + 1))
TR.Activate
'delete all blank rows in column 2
    TRFRng.AutoFilter field:=3, Criteria1:="="
    TRFRng.SpecialCells _
    (xlCellTypeVisible).EntireRow.Delete
'subtotal formulas
    Set paidOUTrng = TR.Range("d9:d" & lastrowtr)
    Set paidINrng = TR.Range("E9:E" & lastrowtr)
    paidOUTrng.Name = "PaidOUT"
    paidINrng.Name = "PaidIN"
    TR.Range("D3").Formula = "=subtotal(9,(PaidOUT)"
    TR.Range("E3").Formula = "=subtotal(9,(PaidIN))"
    TR.AutoFilterMode = False
'apply autofilter
    TRFRng.AutoFilter
SI.Visible = False
Application.ScreenUpdating = True
 End Sub
 
Upvote 0
Thanks! it worked. i had to eventually construct the workbook again and add the code to this, then it started working

:) :)
 
Upvote 0

Forum statistics

Threads
1,215,022
Messages
6,122,721
Members
449,093
Latest member
Mnur

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