Solved VBA copy a coumn contains certain charactor

June 16, 2017 at 01:40:57
Specs: Windows 7
Hello there..

Can I use VBA to copy column A to column B or C as below? Basically if it contains T511 it will copy to column B and if it contains PILC it will copy to column C.. and I have a lot of data... Thank you.

  
column A
T511-51113
PILC-88-88-999-99-99
T511-51202
T511-51000
PILC-88-88-999-99-99
T511-51202
T511-51112
PILC-88-88-999-99-99
T511-51202

column B	column C
T511-51113	
	       PILC-88-88-999-99-99
T511-51202	
T511-51000	
	       PILC-88-88-999-99-99
T511-51202	
T511-51112	
	       PILC-88-88-999-99-99
T511-51202	
 

message edited by suzysss


See More: VBA copy a coumn contains certain charactor

Reply ↓  Report •

✔ Best Answer
June 16, 2017 at 02:51:11
Ok this one should do it

Dim Bcell As Range
Dim NextBRow, NextCRow As Long

Sub CreateTable()
    
    For Each Bcell In Range("A1", Range("A" & Rows.Count).End(xlUp))
        
        If Mid(Bcell, 1, 4) = "T511" Then
            Bcell.Copy

            Range("B" & Bcell.Row).PasteSpecial xlPasteValues
            
        ElseIf Mid(Bcell, 1, 4) = "PILC" Then
            Bcell.Copy
            
            Range("C" & Bcell.Row).PasteSpecial xlPasteValues

        End If
        
    Next Bcell

End Sub

message edited by AlwaysWillingToLearn



#1
June 16, 2017 at 01:47:56
Such a poor explaination of your requirements, please rememeber we can not see your workbook and have never seen it before. So you really need to explain from the beginning how your workbook is laid out, what your tables look like, where the code needs to copy FROM and TO..... all this is relavent as programming is VERY specific.

Also when providing data you must include column and row headings, and tell us what the data is. For example, the above means nothing to me, its just a bunch of data. Totally meaningless.

Use the Pre Tags to present you data properly, read the below to understand how to do that, then try agin

https://www.computing.net/howtos/sh...

message edited by AlwaysWillingToLearn


Reply ↓  Report •

#2
June 16, 2017 at 01:57:28
yes I checked up the link, thanks .

message edited by suzysss


Reply ↓  Report •

#3
June 16, 2017 at 02:28:28
Try this on for size

Dim Bcell As Range
Dim NextBRow, NextCRow As Long

Sub CreateTable()
    
    For Each Bcell In Range("A1", Range("A" & Rows.Count).End(xlUp))
        
        If Mid(Bcell, 1, 4) = "T511" Then
            Bcell.Copy
            
            NextBRow = Range("B" & Rows.Count).End(xlUp).Row
         
            If Range("B1") = Empty Then
                Range("B1").PasteSpecial xlPasteValues
            Else
                Range("B" & NextBRow + 1).PasteSpecial xlPasteValues
            End If
            
        ElseIf Mid(Bcell, 1, 4) = "PILC" Then
            Bcell.Copy
                        
            NextCRow = Range("C" & Rows.Count).End(xlUp).Row
            
            If Range("C1") = Empty Then
                Range("C1").PasteSpecial xlPasteValues
            Else
            
                Range("C" & NextCRow + 1).PasteSpecial xlPasteValues
            End If
            
        End If
        
    Next Bcell

End Sub


Reply ↓  Report •

Related Solutions

#4
June 16, 2017 at 02:45:54
Thanks! but it looks like this now:

column A	     column B	column C
T511-51113	     T511-51113	PILC-88-88-999-99-99
PILC-88-88-999-99-99 T511-51202	PILC-88-88-999-99-99
T511-51202	     T511-51000	PILC-88-88-999-99-99
T511-51000	     T511-51202	
PILC-88-88-999-99-99 T511-51112	
T511-51202	     T511-51202	
T511-51112		
PILC-88-88-999-99-99		
T511-51202		

what I really want is that B and C still follow the column A sequence

column A	   column B	column C
T511-51113	   T511-51113	
PILC-88-88-999-99-99		PILC-88-88-999-99-99
T511-51202	   T511-51202	
T511-51000	   T511-51000	
PILC-88-88-999-99-99		PILC-88-88-999-99-99
T511-51202	   T511-51202	
T511-51112	   T511-51112	
PILC-88-88-999-99-99		PILC-88-88-999-99-99
T511-51202	   T511-51202	


Reply ↓  Report •

#5
June 16, 2017 at 02:51:11
✔ Best Answer
Ok this one should do it

Dim Bcell As Range
Dim NextBRow, NextCRow As Long

Sub CreateTable()
    
    For Each Bcell In Range("A1", Range("A" & Rows.Count).End(xlUp))
        
        If Mid(Bcell, 1, 4) = "T511" Then
            Bcell.Copy

            Range("B" & Bcell.Row).PasteSpecial xlPasteValues
            
        ElseIf Mid(Bcell, 1, 4) = "PILC" Then
            Bcell.Copy
            
            Range("C" & Bcell.Row).PasteSpecial xlPasteValues

        End If
        
    Next Bcell

End Sub

message edited by AlwaysWillingToLearn


Reply ↓  Report •

#6
June 16, 2017 at 02:57:24
genius!!!!!! thanks it works perfectly!

Reply ↓  Report •

#7
June 16, 2017 at 03:01:30
Awesome glad it work!

Reply ↓  Report •

Ask Question