Compare files & Insert row per condition VBA Solved/Closed

Question

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. XXAAAAAAA BBBBBBB XXCCC DDDDD ============================================================ XXAAAAAAAXXXXXXXXX Line1 Line2 Line3 Line4 Line5 XXCCCXXXXXXXXX Line1 Line2 Line3 Line4 Line5 ============================================================ XXAAAAAAAXXXXXXXXX Line1 Line2 Line3 Line4 YAAAAAAA BBBBBBB Line5 XXCCCXXXXXXXXX Line1 Line2 Line3 Line4 YCCC DDDDD Line5 =========================================================== Configuration: Windows XP / Internet Explorer 7.0

rizvisa1 · Accepted Answer

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

rizvisa1 · Answer

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.

Compare files & Insert row per condition VBA

2 responses

Similar discussions

Subscribe To Our Newsletter!