• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 211
  • Last Modified:

For-Next routine that considers only the non-blank cells in its range

In the code below, how do I define my variable "xCel" so that the macro doesn't even look at the blank cells in the range "S1Codes." In my current workbook only 240 of the 772 cells in S1Codes have values in them, but of course the macro is looking at all 772 cells.

I know the code is clunky in that it keeps going back and forth between the two workbooks but I have no idea how to get this level of intricate detail any other way. In any event, the macro is doing the job very well, I'd just like to make it a little faster and more elegant.

Thanks,
John
Sub CopySCodes()
Dim xCel As Range, lft As Range, rgt As Range
For Each xCel In [S1Codes]
    Dim ws As String
    ws = xCel.Offset(0, 3)
    If xCel = "" Then GoTo here
    Set lft = xCel.Offset(0, 6)
    Set rgt = lft.End(xlToRight)
    lft.Select
    Dim i As Long
    For i = lft.Column To rgt.Column
    ThisWorkbook.Activate
    If Cells(xCel.Row, i) = "" Or xCel = "" Then GoTo here
        Dim str As String, dt As Date, sCode As Range
        str = Cells(xCel.Row, i)
        dt = Cells(xCel.Row, [RoundOpenDates].Column)
        Set sCode = xCel
        
        ActiveWindow.ActivateNext
        Sheets(ws).Activate
        Dim Seat As Range, dtRng As Range, targ As Range
        Set dtRng = Rows("5:5").Find(What:=dt, After:=Cells(5, 3), LookIn:=xlValues)
        If dtRng Is Nothing Then GoTo Kansas
        Set Seat = Columns("C:C").Find(What:=str, After:=Cells(1, 3), LookIn:=xlValues)
        
        If Seat Is Nothing Then GoTo Kansas
        Set targ = Cells(Seat.Row, dtRng.Column)
        targ = sCode
        Sheets(ws).UsedRange.Calculate
Kansas:
    Next
here:
    ThisWorkbook.Activate
Next
End Sub

Open in new window

0
gabrielPennyback
Asked:
gabrielPennyback
2 Solutions
 
khairilCommented:
hi,

instead of using

Cells(xCel.Row, i) = ""

Open in new window


use this,

IsEmpty(Cells(xCel.Row, i))

Open in new window

0
 
jppintoCommented:
Please try like this:

Cells(xCel.Row, i).Value = ""
0
 
Davy2270Commented:
As you work with a defined name, it will always take each cell into consideration.

One way to work round this, is to first sort your table on S1Codes highest to lowest.
Then add this code right after :For Each xCel In [S1Codes]
If IsEmpty(xCel) Then
    Exit Sub
End If

This means the code will stop from the moment the first empty cell is reached.

Davy
0
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 
regmigrantCommented:
If you cant sort the codes as recommended by Davy why not create an array of non blank codes from S1codes first and then loop through that instead - you can then dump all the checking for blanks because you know you already did that

I think you can also move some of the Dim statements outside the loop so they dont keep getting redefined
0
 
gabrielPennybackAuthor Commented:
Thanks everybody. Davy2270, the sorting seems like a good idea, I'll try it as soon as I get back from a staff meeting.  regmigrant, can you give me an example of what you're talking about? It seems to me that the code would still be checking all the non-significant filled cells too, no?

I was trying to do it by defining the next exCel as xCel.end(xlDown), but I just couldn't figure out how to handle the "For i = 6 to ??. Does that make sense?  I always test code by selecting and I had something like that going but it failed because the macro would select the 'xCel.End(xlDown)' cell, but then it would revert to the cell directly beneath the former selected cell.

I hope this isn't too confusing.

Thanks,
John
0
 
dlmilleCommented:
My two cents.  I did this pretty fast, but hopefully you get the idea.

I moved all dimensions to the top - no need to put them in just before they are needed.  Would need to check, but you might be allocating space each time its hit inside your code.  Not a biggie.

You touch the spreadsheets too much, in my opinion.  I'm not sure there are any statements that actually require any of the sheets/workbooks to be active, if we prefix our statements correctly with the right workbook/worksheet prefix.

Application.ScreenUpdating = False will help, if you're doing alot of touching (re: activating, moving cells around, etc., but in my opinion 99% of code doesn't require you to activate or select anything - and your performance should go way up as a result! - at least as much as its pulled down as a result of doing these things :)

So, these were the two main areas I touched.  Again, I did this pretty quick and hopefully you get quick value from it, as well.

You had a command toward the bottom:  targ = sCode - not sure how that ever worked as both are ranges - are you setting targ.value = sCode.value, or are you trying to make a range assignment?  Hard to debug, I thought the latter...

That raises one more point.  I know the default property on a range object is .Value, but I suggest (and follow this myself) being explicit with that, otherwise the above comment can make debugging hard in the future - and sometimes let code slip by with faults undetected!


So, my two cents:

 

Dave
Sub CopySCodes()
Dim xCel As Range, lft As Range, rgt As Range
Dim Seat As Range, dtRng As Range, targ As Range
Dim wkb As Workbook, wks As Worksheet, AltWS As Worksheet
Dim str As String, dt As Date, sCode As Range
Dim ws As String
Dim i As Long
    
    Application.ScreenUpdating = False
    
    Set wkb = ThisWorkbook
    Set wks = wkb.ActiveSheet
    
    For Each xCel In [S1Codes]

        ws = xCel.Offset(0, 3).Value
        Set AltWS = wkb.Sheets(ws)
        
        If xCel.Value = "" Then GoTo here
        
        Set lft = xCel.Offset(0, 6)
        Set rgt = lft.End(xlToRight)
        'lft.Select

        For i = lft.Column To rgt.Column
        
        If wks.Cells(xCel.Row, i).Value = "" Or xCel.Value = "" Then GoTo here

            str = wks.Cells(xCel.Row, i).Value
            dt = wks.Cells(xCel.Row, [RoundOpenDates].Column).Value
            Set sCode = xCel
            
            'ActiveWindow.ActivateNext
            'Sheets(ws).Activate

            
            Set dtRng = AltWS.Rows("5:5").Find(What:=dt, After:=Cells(5, 3), LookIn:=xlValues)
            If dtRng Is Nothing Then GoTo Kansas
            
            Set Seat = AltWS.Columns("C:C").Find(What:=str, After:=Cells(1, 3), LookIn:=xlValues)
            
            If Seat Is Nothing Then GoTo Kansas
            
            Set targ = AltWS.Cells(Seat.Row, dtRng.Column)
            Set targ = sCode
            AltWS.UsedRange.Calculate
Kansas:
        Next i
here:
        'ThisWorkbook.Activate
    Next xCel
    
    Application.ScreenUpdating = True
End Sub

Open in new window


Dave
0
 
gabrielPennybackAuthor Commented:
Thanks to the Daves!

- John
0

Featured Post

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now