Find and blank cell then Do this.....

  • Thread starter Thread starter Bonnie
  • Start date Start date
B

Bonnie

Hello All
I hope someone can help me with this ASAP

I have a Sheet that in column G I want my VBA to look
down for a blank cell, when it finds a blank cell goto
column S (same row that the blank in G was found) and do
a copy, go up one cell, paste special/value. Then go back
G and continue on..etc. etc.

this is what I have so far
and it works, but only for one copy and paste in column S
How can I define the "range" in S so that I do not have
to use a cell ref. exp. "S3"

Any help would be good
Thank you!!

Sub CopyPaste()

Dim Counter
Dim i As Integer

Counter = 600
Range("g1").Select
ActiveCell.Select
For i = 1 To Counter
If ActiveCell = "" Then
Range("S3").Select
Application.CutCopyMode = False
Selection.Copy
ActiveCell.Offset(-1, 0).Select
Selection.PasteSpecial Paste:=xlValues,
Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False

Else
ActiveCell.Offset(1, 0).Select
End If
Next i
End Sub
 
if the cells are really blank

Sub WorkonS()
dim rng as rng, cell as range
On error resume next
set rng = Columns(7).specialCells(xlBlanks)
On error goto 0
if rng is nothing then
msgbox "No blanks in Column G"
exit sub
End if
set rng = Intersect(rng.EntireRow, Range("S1").EntireColumn)
for each cell in rng
cell.offset(-1,0).Value = cell.value
Next
end Sub
 
One way:

Public Sub test1()
Dim cell As Range
On Error Resume Next
For Each cell In Columns("G").SpecialCells(xlCellTypeBlanks)
With cell.Offset(0, 12) 'Column S
.Offset(-1, 0).Value = .Value
End With
Next cell
on Error GoTo 0
End Sub

Note that you almost never need to select/activate. Working with the
range objects directly results in code that is smaller, faster, and
in my opinion, easier to maintain.

The On Error Resume Next is necessary since SpecialCells() will
throw an error if there are no blank cells in column G.
 
I am getting a complie error on
"Dim rng As rng"

-----Original Message-----
if the cells are really blank

Sub WorkonS()
dim rng as rng, cell as range
On error resume next
set rng = Columns(7).specialCells(xlBlanks)
On error goto 0
if rng is nothing then
msgbox "No blanks in Column G"
exit sub
End if
set rng = Intersect(rng.EntireRow, Range ("S1").EntireColumn)
for each cell in rng
cell.offset(-1,0).Value = cell.value
Next
end Sub

--
Regards,
Tom Ogilvy





.
Click to expand...
 
THANK YOU!!!!!!
-----Original Message-----
if the cells are really blank

Sub WorkonS()
dim rng as rng, cell as range
On error resume next
set rng = Columns(7).specialCells(xlBlanks)
On error goto 0
if rng is nothing then
msgbox "No blanks in Column G"
exit sub
End if
set rng = Intersect(rng.EntireRow, Range ("S1").EntireColumn)
for each cell in rng
cell.offset(-1,0).Value = cell.value
Next
end Sub

--
Regards,
Tom Ogilvy





.
Click to expand...
 
THANK YOU!!!!!!
-----Original Message-----
One way:

Public Sub test1()
Dim cell As Range
On Error Resume Next
For Each cell In Columns("G").SpecialCells (xlCellTypeBlanks)
With cell.Offset(0, 12) 'Column S
.Offset(-1, 0).Value = .Value
End With
Next cell
on Error GoTo 0
End Sub

Note that you almost never need to select/activate. Working with the
range objects directly results in code that is smaller, faster, and
in my opinion, easier to maintain.

The On Error Resume Next is necessary since SpecialCells () will
throw an error if there are no blank cells in column G.


.
Click to expand...
 
typo

Sub WorkonS()
Dim rng As Range, cell As Range
On Error Resume Next
Set rng = Columns(7).SpecialCells(xlBlanks)
On Error GoTo 0
If rng Is Nothing Then
MsgBox "No blanks in Column G"
Exit Sub
End If
Set rng = Intersect(rng.EntireRow, Range("S1").EntireColumn)
For Each cell In rng
cell.Offset(-1, 0).Value = cell.Value
Next
End Sub

Tested in xl97
 
Back
Top