Cleaning up the UsedRange

[bradyboyy88]

I have a workbook and the first row is used for markers of important columns. The identifier basically lets me know there is important data in that column. I have been trying to shortening my looping of cells through used range but I am weak on it. First I want to loop through the first row of the usedrange which I assume is row 1 and then build my range of important columns. Then I want to loop through each of the cells of this range. to collect and do other modifications too. So how do I efficiently loop through in this method. Here is my code so far:

Sub copyTracker()


    Dim xlApp As Application
    Dim wb As Workbook
    Dim filepath As String
    Dim cell As Range
 
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = True
    
    filepath = "C:\path\import.xlsx"
    
    xlApp.AskToUpdateLinks = False
    xlApp.DisplayAlerts = False
    Set wb = xlApp.Workbooks.Open(Filename:=filepath, ReadOnly:=True)
    xlApp.DisplayAlerts = True
    xlApp.AskToUpdateLinks = True
    
    For Each cell In wb.Sheets("Sheet1").UsedRange.Rows(1)
            'not sure how but I to take the intersect of the the UsedRange and these columns with markers and assign them to another range I can foreach through.
    Next cell
    
End Sub

 

[bobsan42]

Typing on my phone, but something like:

Dim rng, ur
Set ur =wb.Sheets("Sheet1").UsedRange 
For Each cell In ur.resize(1)If cell.value = marker then
If not rng is nothing then set rng =union(rng,cell) else set rng = cell            
End if
 Next cell
Set ur=ur.offset(1).resize(ur.rows.count-1)
Set rng =intersect(ur,rng.entirecolumn)

 

[bradyboyy88]

Typing on my phone, but something like:

Dim rng, ur
Set ur =wb.Sheets("Sheet1").UsedRange 
For Each cell In ur.resize(1)If cell.value = marker then
If not rng is nothing then set rng =union(rng,cell) else set rng = cell            
End if
 Next cell
Set ur=ur.offset(1).resize(ur.rows.count-1)
Set rng =intersect(ur,rng.entirecolumn)

I took your code and modified it just a little bit but I get application or object defined error at the union line. My console prints out the following debugs: 3 4 1. Any ideas?

Option Explicit


Sub copyTracker()


    Dim xlApp As Application
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim filepath As String
    Dim cell As Range
    Dim targetCols As Object
    Dim rowInd As Integer
    Dim mmcidCol As Integer
    Dim ur As Object
    Dim rng As Object
    
    Set targetCols = CreateObject("Scripting.Dictionary")
    
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = True
    
    filepath = "C:\\path\import.xlsx"
    
    xlApp.AskToUpdateLinks = False
    xlApp.DisplayAlerts = False
    Set wb = xlApp.Workbooks.Open(Filename:=filepath, ReadOnly:=True)
    Set ws = wb.Worksheets.Add(Type:=xlWorksheet)
    Set ur = wb.Sheets("Sheet1").UsedRange
    xlApp.DisplayAlerts = True
    xlApp.AskToUpdateLinks = True
        
    For Each cell In ur.Resize(1)
        If cell.Value <> "Version" And cell.Value <> "ID" And cell.Value <> "" Then
            If Not rng Is Nothing Then
                Debug.Print 1
                Set rng = Union(rng, cell)
                Debug.Print 2
            Else
                Debug.Print 3
                Set rng = cell
                Debug.Print 4
            End If
        ElseIf cell.Value = "ID" Then
            Debug.Print 5
            mmcidCol = cell.Column
            Debug.Print 6
        End If
    Next cell
     
    Debug.Print 7
    Set ur = ur.Offset(1).Resize(ur.Rows.Count - 1)
    Debug.Print 8
    Set rng = Intersect(ur, rng.EntireColumn)
    Debug.Print 9
    
    rowInd = 1
    
    For Each cell In rng
        'Output MMCID
        ws.Range("A" & rowInd).Value = wb.Sheets("Sheet1").Cells(cell.Row, mmcidCol).Value
        'Output Version
        ws.Range("B" & rowInd).Value = wb.Sheets("Sheet1").Cells(1, cell.Column).Value
        'Output Round
        ws.Range("C" & rowInd).Value = wb.Sheets("Sheet1").Cells(2, cell.Column).Value
        'Output Step
        ws.Range("D" & rowInd).Value = wb.Sheets("Sheet1").Cells(3, cell.Column).Value
        rowInd = rowInd + 1
    Next cell
    
End Sub

 

[bobsan42]

Dim ur as Range, rng as Range

the other option is to leave them blank which means Variant.

Dim rng, ur

 

[bradyboyy88]

Dim ur as Range, rng as Range

the other option is to leave them blank which means Variant.

Dim rng, ur

I declared them as range and it still draws the error

 

[bobsan42]

OK - think I got it.
You create an external Application. Turns out Union and Intersect are members of Excel.Application
If not explicitly mentioned it takes the Current application and tries to give it ranges from the external application.

so for this to work in your case use them like this:

xlApp.Union(....)
xlApp.Intersect (....)

 

[bradyboyy88]

Wow that did the trick. Figures it would be something like that but I can honestly say i wasnt going to figure that out because I didnt realize that. If I wanted to exclude an extra row say 5 from the final rng, what do you think would be the best method for doing that. I realize I have a row with column headers in it and that starts at like row 5 and I want to remove that.

 

[bradyboyy88]

Also, I have a similar issue related to the object defined error. I use xlApp.Calculation=xlManualCalculation but it always returns an object defined error. Are you not allowed to set properties like this for newly created instances of excel?

 

[bobsan42]

if I need to remove top row from a range I would move it 1 row down then resize it with 1 row less.
something like:

set rng=rng.offset(1).resize(rng.rows.count-1)

 

[bobsan42]

the value name is wrong - it is xlCalculationManual
However - xlapp is not explicitly declared as Excel Application.
when work with external apps I would not use the native enumerated names but rather the actual values - this helps avoiding compilation errors.
In this particular case : xlCalculationManual=-4135
so it would look like:

[COLOR=#333333]xlApp.Calculation=-4135[/COLOR]