Compare files & Insert row per condition VBA

Solved/Closed
j3kj3k
Posts
16
Registration date
Tuesday June 1, 2010
Status
Member
Last seen
July 11, 2012
- Jun 1, 2010 at 05:07 PM
j3kj3k
Posts
16
Registration date
Tuesday June 1, 2010
Status
Member
Last seen
July 11, 2012
- Jun 15, 2010 at 06:37 PM
Hello, VBA Gurus
I am new here and trying to learn VBA and accoplish some task for my work.
Is it possible to have a script to meet the following condition.
Thanks in advance.
J3K


(1) read characters before space (like XXAAAAAAA or XXCCC) from FileA
(2) if there are any row that starts with it (XXAAAAAAA or XXCCC) in FileB, then insert a new line with whole line from FileA after 4th line. But replace XX to Y.

<lookup : FileA>
XXAAAAAAA BBBBBBB
XXCCC DDDDD
============================================================
<file to be updated : FileB>
XXAAAAAAAXXXXXXXXX
Line1
Line2
Line3
Line4
Line5
XXCCCXXXXXXXXX
Line1
Line2
Line3
Line4
Line5
============================================================
<file after update : FileB>
XXAAAAAAAXXXXXXXXX
Line1
Line2
Line3
Line4
YAAAAAAA BBBBBBB
Line5
XXCCCXXXXXXXXX
Line1
Line2
Line3
Line4
YCCC DDDDD
Line5
===========================================================







2 replies

rizvisa1
Posts
4479
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
May 5, 2022
769
Jun 3, 2010 at 06:10 PM
See if that works for you. I am presuming that all "XX" had to be replaced with "Y"

Sub FixData()  
Dim SheetName1 As String  
Dim SheetName2 As String  

Dim WS1 As Worksheet  
Dim WS2 As Worksheet  

Dim lRowWS1 As Long  
Dim lRowWS2 As Long  

Dim iTempWS1 As Integer  
Dim iTempWS2 As Integer  

Dim lFixRow As Long  

    SheetName1 = "FileA"  
    SheetName2 = "FileB"  
          
    Set WS1 = Sheets(SheetName1)  
    Set WS2 = Sheets(SheetName2)  
      
    lRowWS1 = WS1.Cells(Rows.Count, "A").End(xlUp).Row  
    lRowWS2 = WS2.Cells(Rows.Count, "A").End(xlUp).Row  
      
    iTempWS1 = WS1.Cells.Find("*", Cells(1, 1), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Column + 1  
    iTempWS2 = WS2.Cells.Find("*", Cells(1, 1), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Column + 1  
      
    WS1.Select  
    With Range(Cells(1, iTempWS1), Cells(lRowWS1, iTempWS1))  
      
        .FormulaR1C1 = "=""|*| "" & LEFT(RC1, FIND("" "", RC1, 1)-1)"  
        .Copy  
        .PasteSpecial xlPasteValues  
      
    End With  
      
      
    With Range(Cells(1, iTempWS1 + 1), Cells(lRowWS1, iTempWS1 + 1))  
      
        .FormulaR1C1 = "=SUBSTITUTE(RC1, ""XX"", ""Y"")"  
        .Copy  
        .PasteSpecial xlPasteValues  
      
    End With  
      
      
    With Range(Cells(1, iTempWS1 + 2), Cells(lRowWS1, iTempWS1 + 2))  
      
        .FormulaR1C1 = "=LEN(RC" & iTempWS1 & ")"  
        .Copy  
        .PasteSpecial xlPasteValues  
      
    End With  
      
    Range(Cells(1, iTempWS1), Cells(lRowWS1, iTempWS1 + 2)).Select  
    Selection.Sort _
                    Key1:=Cells(1, iTempWS1 + 2), Order1:=xlAscending, _
                    Key2:=Cells(1, iTempWS1), Order2:=xlAscending, _
                    Key3:=Cells(1, iTempWS1 + 1), Order3:=xlAscending, _
                    Header:=xlNo, MatchCase:=False
      
          
    WS2.Select  
      

    With Range(Cells(1, iTempWS2), Cells(lRowWS2, iTempWS2))  
      
        .FormulaR1C1 = "=""|*| "" & RC1"  
        .Copy  
        .PasteSpecial xlPasteValues  
      
    End With  
      
      
    With Range(Cells(1, iTempWS2 + 1), Cells(lRowWS2, iTempWS2 + 1))  
      
        .FormulaR1C1 = "=LOOKUP(10000,SEARCH('" & SheetName1 & "'!R1C" & iTempWS1 & ":R" & lRowWS1 & "C" & iTempWS1 & ", RC" & iTempWS2 & ",1),'" & SheetName1 & "'!C" & iTempWS1 + 1 & ":C" & iTempWS1 + 1 & ")"  
        .Copy  
        .PasteSpecial xlPasteValues  
      
    End With  
      
      
    With Range(Cells(1, iTempWS2 + 2), Cells(lRowWS2, iTempWS2 + 2))  
      
        .FormulaR1C1 = "=IF(ISERROR(RC[-1]), """", RC[-1])"  
        .Copy  
        .PasteSpecial xlPasteValues  
      
    End With  
      
      
    For lFixRow = 1 To lRowWS2  
          
        If (Cells(lFixRow, iTempWS2 + 2) <> "") Then  
          
            Rows(lFixRow + 5).Insert  
            Cells(lFixRow + 5, 1) = Cells(lFixRow, iTempWS2 + 2)  
            lRowWS2 = lRowWS2 + 1  
        End If  
          
    Next lFixRow  
      
      
    Range(Cells(1, iTempWS2), Cells(lRowWS2, iTempWS2 + 2)).Clear  
      
    WS1.Select  
    Range(Cells(1, iTempWS1), Cells(lRowWS2, iTempWS1 + 2)).Clear  
      
    Set WS1 = Nothing  
    Set WS2 = Nothing  
      

End Sub  
2
rizvisa1
Posts
4479
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
May 5, 2022
769
Jun 1, 2010 at 05:30 PM
Could you please upload a sample file with sample data etc on some shared site like https://authentification.site , http://wikisend.com/ , http://www.editgrid.com etc and post back here the link to allow better understanding of how it is now and how you foresee.
0
j3kj3k
Posts
16
Registration date
Tuesday June 1, 2010
Status
Member
Last seen
July 11, 2012

Jun 1, 2010 at 06:16 PM
Here they are : Let me know if you have any issue to see the file.

http://www.editgrid.com/user/j3kj3k/FileA
http://www.editgrid.com/user/j3kj3k/FileB
http://www.editgrid.com/user/j3kj3k/FileB-RESULT

Thanks!!!!!
0
rizvisa1
Posts
4479
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
May 5, 2022
769
Jun 1, 2010 at 07:50 PM
Could FileA and FileB be incorporated into same workbook as two different worksheet?
0
j3kj3k
Posts
16
Registration date
Tuesday June 1, 2010
Status
Member
Last seen
July 11, 2012

Jun 3, 2010 at 02:33 PM
Hi rzvisa1
Absolutely.... I just separated input and output data on a diffrent files just to make my question clear.
Thanks.
0
j3kj3k
Posts
16
Registration date
Tuesday June 1, 2010
Status
Member
Last seen
July 11, 2012

Jun 3, 2010 at 06:45 PM
Thanks rzvisa1 !!!!!!!!!!!
0
rizvisa1
Posts
4479
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
May 5, 2022
769
Jun 3, 2010 at 08:27 PM
I have just updated the code. The sort was wrong. If stars and moon align, it would have given you wrong result. You should update too
0