View Full Version : IF THEN Macro
yoitsmejy
05-09-2011, 12:45 PM
Hi, I need help with the following below code. What I am trying to do is to copy G1 to any cells in column G as long as there is a value next to it. The code is relatively very slow and it shows N/A on the first column that has no value in F. Please help me.
Sub gsnu()
Dim r As Range
Set r = ActiveSheet.UsedRange
nLastRow = r.Rows.Count + r.Row - 1
For i = 1 To nLastRow
If IsEmpty(Cells(i, 6).Value) Then
Else
Cells(i + 1, 7).Value = Cells(1, 7).Formula
End If
Next
End Sub
Paul_Hossler
05-09-2011, 01:55 PM
The way I'd do it
 
Option Explicit
Sub TEST()
    Dim rBlanks As Range, rLast As Range, rCell As Range
 
    Set rLast = ActiveSheet.Cells(ActiveSheet.Rows.Count, 7).End(xlUp)
    Set rBlanks = Nothing
 
    On Error Resume Next
    Set rBlanks = Range(ActiveSheet.Range("G2"), rLast)
    On Error GoTo 0
 
    If rBlanks Is Nothing Then Exit Sub
 
    Application.ScreenUpdating = False
    For Each rCell In rBlanks.Cells
        If Len(rCell.Offset(0, -1)) > 0 Then rCell.Value = ActiveSheet.Range("G1")
    Next
    Application.ScreenUpdating = True
 
End Sub
 
Paul
Chabu
05-09-2011, 01:56 PM
Hello ,
First I would avoid counting on "activesheet.usedrange". That is way to sensible to not correspond to the range of the G column (if cells to the right or lower are filled in).
Try to declare objects (certainly in loops) instead of making excel expand references.
The following worked fine for me
Public Sub gsnu2()
    Dim r As Range
    Dim s As Range
    Dim nLastRow As Integer
    Dim i As Integer
    
    Set s = ActiveSheet.Cells(1, 7)
    Set r = ActiveSheet.Range(Cells(1, 6), Cells(1, 6).End(xlDown))
    
    nLastRow = r.Count
    For i = 2 To nLastRow
        s.Copy Destination:=Cells(i, 7)
    Next
    
End Sub
Chabu
05-09-2011, 01:59 PM
two replies from timezones 5 hours apart with one minute difference :-)
yoitsmejy
05-10-2011, 12:15 PM
Hey Chabu, your code works great. I was wondering if you can help me make this code work faster. Perhaps if the cells in G have value, then go to the empty cell only?
Chabu
05-11-2011, 01:42 PM
Hello yoitsmejy,
the line
Set r = ActiveSheet.Range(Cells(1, 6), Cells(1, 6).End(xlDown))
will only select down to the end of a continuous range, so by definition every cell in range r is not empty.
I'm only coding VBA for a few months so I'm not really knowlegable on what would be more performant.
Paul_Hossler
05-11-2011, 04:16 PM
I'm still fuzzy on your specific requirements, but look at this to see if it helps
 
Option Explicit
 
Sub TEST()
 
    Dim rBlanks As Range, rLast As Range, rCell As Range
 
    'get the last cell in col G by going from the last row up to the first non-blank cell
    Set rLast = ActiveSheet.Cells(ActiveSheet.Rows.Count, 7).End(xlUp)
 
    'set this to Nothing to test for no blank cells
    Set rBlanks = Nothing
 
    On Error Resume Next
    'rBlanks will be only the cells between G2 and the last non-blank cell in col G that are blank
    Set rBlanks = Range(ActiveSheet.Range("G2"), rLast).SpecialCells(xlCellTypeBlanks)
    On Error GoTo 0
 
    If rBlanks Is Nothing Then Exit Sub
 
    'speed up
    Application.ScreenUpdating = False
 
    'for each of the blank cells in Col G
    For Each rCell In rBlanks.Cells
 
        'if the cell in the same row in Col H is not blank (this next??)
        If Len(rCell.Offset(0, 1)) > 0 Then
 
            'copy the value in G1 to the blank cell in col G
            rCell.Value = ActiveSheet.Range("G1")
        End If
    Next
    Application.ScreenUpdating = True
 
End Sub
 
 
Paul
yoitsmejy
05-12-2011, 07:24 AM
paul, I am trying to essentially update column G on a daily basis. Everyday there should be a new row generated into the worksheet. So, everything prior to that we dont need to update. The tricky part is that the row number for each worksheets are different. Is this clearer?
Paul_Hossler
05-12-2011, 12:06 PM
Is this clearer?
 
Sorry, still not grasping what you want to do I guess.
 
What I am trying to do is to copy  G1 to any cells in column G as long as there is a value next to it.
 
If you don't get a good answer, maybe an example workbook with just  a little bit of Before & After data would help 
 
Sorry
 
Paul
yoitsmejy
05-13-2011, 06:52 AM
Column A-F is Automatically updated daily. When A-F is updated, I would like to have a macro that fills the blank cell (next to the updated A-F)in column G with the formula in G1. The prior filled cells in column G, will not change so I would like the macro to ignore the filled cells in Column G and just fill in the blank cell. Now column G1 has a vlookup formula which linked to a different workbook.
Paul_Hossler
05-13-2011, 10:01 AM
Sub Test3()
    
    Application.ScreenUpdating = False
     
    On Error Resume Next
    With ActiveSheet
        .Cells(1, 1).CurrentRegion.Columns(7).SpecialCells(xlCellTypeBlanks).Formula = .Range("G1").Formula
    End With
    On Error GoTo 0
    
    Application.ScreenUpdating = True
     
End Sub
 
Paul
Chabu
05-13-2011, 10:49 AM
Of course you can define your data range as a list (Data/List/Create List)
and Excel will automatically copy any formula in your data range when a new row is added.
No macro needed at all :-)
yoitsmejy
05-16-2011, 06:16 AM
Thanks guys. 
Paul- The code works great.
Powered by vBulletin® Version 4.2.5 Copyright © 2025 vBulletin Solutions Inc. All rights reserved.