PDA

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.