Looping through sub

Anta19

New Member
Joined
Feb 25, 2018
Messages
1
Hi All... new to the forum and pretty new to VBA.. about a week new and looking for some support.
I am writing a script to do table comparisons and am stuck on a loop issue.
for arguments sake say there are 2 folders with different names and inside the folders there are a number of csv files... both folders contain the same files (by filename) but the data in the files may different and i am trying to detect the differences.So in folderA, file1.csv cells A10:A25 and C10:C25 has my numeric data- also in folderB, file1.csv in the same cells there is also numeric data... and likewise in file2,file3 and so on and so forth.


the control WS of my WB has the buttons to control what is going to happen and everything works - however i can only get the first pair of files to load and if they are equal then the differences= nothing, if there are differences then it highlights (i used a COUNTIF to determine differences)


what i need to do is load and then check file1 from both folders, then loop the same sub commands but use the address from the second row of my filename_compare (E4 and F4) for file2, then 3 and so on... i cannot post attachments so i have most of the code below: i just do not know where to put a loop back from the end of sub 'name_move' to restart sub 'load_table' but using E4 and F4 respectively... then E5 and F5 and so on till empty cell


Code:
Sub Load_Table()
    Dim strFName As String
    ActiveWorkbook.Sheets("FileName_Compare").Activate
    strFName = ActiveSheet.Range("E3").Value
              'this variable contains the workbook name and path
    If FileExists(strFName) Then
    'does it exist?
        If Not BookOpen(Dir(strFName)) Then Workbooks.Open Filename:=strFName
        'if its not already open, open it
    Else
        MsgBox "The file does not exist!"
    End If
        Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = ""
    Range("A10:C30").Select
    Selection.Copy
    Windows("Mapping Table Compare.xlsb.xlsm").Activate
    ActiveWorkbook.Sheets("Table_Compare").Activate
    ActiveSheet.Range("A1").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    Call Workbook_Close
    ActiveWorkbook.Sheets("FileName_Compare").Activate
    strFName = ActiveSheet.Range("F3").Value
    'this variable contains the workbook name and path
    If FileExists(strFName) Then
    'does it exist?
        If Not BookOpen(Dir(strFName)) Then Workbooks.Open Filename:=strFName
        'if its not already open, open it
    Else
        MsgBox "The file does not exist!"
    End If
        Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = ""
    Range("A10:C30").Select
    Selection.Copy
    Windows("Mapping Table Compare.xlsb.xlsm").Activate
    ActiveWorkbook.Sheets("Table_Compare").Activate
    ActiveSheet.Range("D1").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    Call Workbook_Close
   Call Compare
    ActiveWorkbook.Sheets("Control").Activate 
End Sub


Function FileExists(strfullname As String) As Boolean
    FileExists = Dir(strfullname) <> ""
End Function


Function BookOpen(strWBName As String) As Boolean
    Dim wbk As Workbook
    On Error Resume Next
    Set wbk = Workbooks(strWBName)
    If Not wbk Is Nothing Then BookOpen = True
End Function






Sub Workbook_Close()
Dim WB As Workbook
For Each WB In Workbooks
If Not (WB Is ActiveWorkbook) Then WB.Close savechanges:=False
Next
End Sub


Sub Compare()
ActiveWorkbook.Sheets("FileName_Compare").Activate
    Range("A3").Select
    Selection.Copy
    ActiveWorkbook.Sheets("Table_Compare").Activate
    Sheets("Table_Compare").Select
    Range("K1").Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Call tester
End Sub


Sub tester()
ActiveWorkbook.Sheets("Table_Compare").Activate
    Range("G1").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=RC[-6]-RC[-3]"
    Range("H1").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=RC[-5]-RC[-2]"
    Range("H2").Select
    Call Copy_Down       
End Sub


Sub Copy_Down()
ActiveWorkbook.Sheets("Table_Compare").Activate
    Range("G1").Select
    ActiveCell.FormulaR1C1 = "=RC[-6]-RC[-3]"
    Selection.Copy
    Range("G2:G25").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Range("H1").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("H2:H25").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        Call Differences
End Sub


Sub Differences()
ActiveWorkbook.Sheets("Table_Compare").Activate
    Range("$I$1").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=COUNTIF(RC[-2]:R[24]C[-1],""<>0"")"
    Range("I2").Select
    Call Name_Move
End Sub


Sub Name_Move()
Dim celltxt As String
ActiveWorkbook.Sheets("Table_Compare").Activate
celltxt = ActiveSheet.Range("I1").Text
If InStr(1, celltxt, "0") Then Exit Sub
   Range("$K$1").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWorkbook.Sheets("Control").Activate
    Sheets("Control").Select
Range("E65536").End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
End Sub

Any insight or help would be appreciated
Many thanks
 
Last edited by a moderator:

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
Welcome to the forum, please use code tags as directed by the forum rules, which you will have read when you joined. I have added them now to make your post more readable
 
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,170
Members
453,021
Latest member
Justyna P

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top