Compare files & Insert row per condition VBA [Solved/Closed]

Report
Posts
16
Registration date
Tuesday June 1, 2010
Status
Member
Last seen
July 11, 2012
-
Posts
16
Registration date
Tuesday June 1, 2010
Status
Member
Last seen
July 11, 2012
-
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

Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
August 2, 2020
768
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
Thank you

A few words of thanks would be greatly appreciated. Add comment

CCM 2942 users have said thank you to us this month

Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
August 2, 2020
768
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.
Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
August 2, 2020
768
Could FileA and FileB be incorporated into same workbook as two different worksheet?
Posts
16
Registration date
Tuesday June 1, 2010
Status
Member
Last seen
July 11, 2012

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

Thanks rzvisa1 !!!!!!!!!!!
Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
August 2, 2020
768
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
Posts
16
Registration date
Tuesday June 1, 2010
Status
Member
Last seen
July 11, 2012

I see your changes. Thanks again !!!!. working fine too.
I have sent a private message for another question.
Thanks again

Subscribe To Our Newsletter!

The Best of CCM in Your Inbox

Subscribe To Our Newsletter!