Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 28
Default copy problem using excel VBA

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



--
Kittie
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 94
Default copy problem using excel VBA

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

http://www.vonixx.com
"Lolly" wrote:

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



--
Kittie

  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 2
Default copy problem using excel VBA

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

Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Excel Copy/Paste Problem AndeTech Excel Discussion (Misc queries) 0 May 4th 06 05:55 PM
Excel sheet copy problem [email protected] Excel Programming 3 January 25th 06 05:00 PM
Problem: How to copy excel sheet in C++ sgwong Excel Programming 0 October 7th 05 02:54 AM
Problem printing more than one copy in excel Excel problem Excel Discussion (Misc queries) 1 June 28th 05 02:54 PM
Excel VBA - Copy Folder problem PaulC Excel Programming 5 August 15th 04 12:08 AM


All times are GMT +1. The time now is 09:37 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright 2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"