View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
Lolly[_2_] Lolly[_2_] is offline
external usenet poster
 
Posts: 28
Default copy cell value problem

hi

I need help on this

I have a data like this for 5 columns.
ColA ColB
SHM SHMP
SHM SHMP
SHM
SHM SHMP
SHM SHMP
SHM
SHM SHMP
SHM SHMP
SHM 合計

COND IN-RO
COND
COND RE-RO
RE-RO
COND
RE-RO
COND RE-RO
COND RE-RO
COND合計

MIX MIX
MIX









I want to look my data like this

colA Col B
SHM SHMP
SHM SHMP
SHM SHMP
SHM SHMP
SHM SHMP
SHM SHMP
SHM SHMP
SHM SHMP
SHM 合計

COND IN-RO
COND IN-RO
COND RE-RO
COND RE-RO
COND RE-RO
COND RE-RO
COND RE-RO
COND RE-RO
COND 合計

MIX MIX
MIX MIX



I created a macro which is as follows
Sub FillColBlanks()
Dim wks As Worksheet
Dim rng As Range
Dim LastRow As Long
Dim col As Long
Dim Col1 As Long
Dim Rng1 As Range


Set wks = ActiveSheet
With wks
Col1 = .Range("a1").Column
col = .Range("b1").Column

Set rng = .UsedRange 'try to reset the lastcell
LastRow = .Cells.SpecialCells(xlCellTypeLastCell).Row
Set rng = Nothing
Set Rng1 = Nothing
On Error Resume Next
Set rng = .Range(.Cells(2, col), .Cells(LastRow, col)) _
.Cells.SpecialCells(xlCellTypeBlanks)
Set Rng1 = .Range(.Cells(2, Col1), .Cells(LastRow, Col1)) _
.Cells.SpecialCells(xlCellTypeBlanks)
On Error GoTo 0

If rng Is Nothing Then
MsgBox "No blanks found"
Exit Sub
Else
rng.FormulaR1C1 = "=R[-1]C"

End If
If Rng1 Is Nothing Then
MsgBox "No blanks found"
Exit Sub
Else
Rng1.FormulaR1C1 = "=R[-1]C"

End If

'replace formulas with values
With .Cells(1, col).EntireColumn
.Value = .Value
End With
With .Cells(1, Col1).EntireColumn
.Value = .Value
End With

End With

End Sub

Now the data looks like this

SHM SHMP
SHM SHMP
SHM SHMP
SHM SHMP
SHM SHMP
SHM SHMP
SHM SHMP
SHM SHMP
SHM合計 SHMP
SHMP SHMP
COND IN-RO
COND IN-RO
COND RE-RO
COND RE-RO
COND RE-RO
COND RE-RO
COND RE-RO
COND RE-RO
COND合計RE-RO
MIX MIX
MIX MIX



But I want a empty cell after next to this
Col A Col B ColC
SHM 合計
SHM SHMP SHM
COND 合計
COND COND CND
MIX MIX PLU

That means if it identifies any character like this it should not copy cell
next to it in the column. This needs to be done for three cells or two cells
next to it.







Any help would be highly appreciated


Thanks a lot


--
Kittie