copy problem using excel VBA

L

Lolly

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
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 next to this
Col A Col B Col C
SHM SHMP DIR
SHM åˆè¨ˆ
COND RE-RO DNG
COND åˆè¨ˆ
MIX MIX MIX
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
 
E

Edwin Tam

Select your whole range, and run the following macro. (Your range can contain
more than 2 columns.)

Sub fill_blanks()
Dim tmp, tmp2
With Selection
If .Rows.Count > 1 Then
For tmp = 1 To .Columns.Count
With .Columns(tmp)
For tmp2 = 2 To .Rows.Count
If .Cells(tmp2).Value = "" Then
If tmp = 1 Then
.Cells(tmp2).Value = .Cells(tmp2 - 1).Value
Else
If InStr(.Cells(tmp2).Offset(0, -(tmp -
1)).Value, _
"åˆè¨ˆ") = 0 Then
.Cells(tmp2).Value = .Cells(tmp2 - 1).Value
End If
End If
End If
Next
End With
Next
End If
End With
End Sub


Regards,
Edwin Tam
(e-mail address removed)
http://www.vonixx.com
Lolly said:
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
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 next to this
Col A Col B Col C
SHM SHMP DIR
SHM åˆè¨ˆ
COND RE-RO DNG
COND åˆè¨ˆ
MIX MIX MIX
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
Click to expand...
 
S

saritathakur90

Hi edwin,

I tried this but it's not working. I way I did was copied it to my
Macro and after selecting the range ran it. Could u please help me
further.
Thanks in advance


kittie
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

copy cell value problem 0
Macro for Fill Blank Cells Macro 2
vba arrays, count blank cells 2
Double_byte find problem 1
Error using..... .Value = .Value 4
Fill down two columns...C & D 4
Macro for compare between 2 workbooks and copy adjacent cells 1
match multiple criteria using VBA 1

Top