Block If without End If

[TimmyTime]

Hey all,

I'm new to vba and I've successfully done a few macros to simplify some processes at work. However currently I'm struggling to create one for this scenario as it gives a "Block If without End If" error;

Sub SAFESections()
Dim FileToOpen As Variant
Dim OpenBook As Workbook

Application.ScreenUpdating = False
FileToOpen = Application.GetOpenFilename(Title:="Browse for your FIle & Import Range", FileFilter:="Excel Files (*.xls*), *xls*")
If FileToOpen <> False Then

Set OpenBook = Application.Workbooks.Open(FileToOpen)
    Range("EU2").Select
    ActiveCell.FormulaR1C1 = _
        "=CONCAT(RIGHT(RC[-146],LEN(RC[-146])-FIND("" "",RC[-146])),"", "",LEFT(RC[-146],FIND("" "",RC[-146])-1))"
    Range("EU2").Select
    Selection.AutoFill Destination:=Range("EU2:EU1244")
    Range("EU2:EU1244").Select
   
OpenbookLastRow = OpenBook.Sheets(1).Range("EU2" & Rows.Count).End(xlUp).Row
MasterBookLastRow = ThisWorkbook.Worksheets("NSW Data").Range("C4" & Rows.Count).End(xlUp).Row
    For r = 2 To OpenbookLastRow
    For m = 4 To MasterBookLastRow
    If OpenBook.Sheets(1).Range("EU2" & r).value = ThisWorkbook.Worksheets("NSW Data").Range("C4" & r).value Then
   
        OpenBook.Sheets(1).Range("AQ", "BC", "BN", "BX", "CJ", "CT", "DI", "DT", "EJ").Copy
        ThisWorkbook.Worksheets("NSW Data").Activate
        lastRowRpt = ThisWorkbook.Worksheets("NSW Data").Range("O4" & Rows.Count).End(xlUp).Row
        ThisWorkbook.Worksheets("NSW Data").Range("O4" & lastRowRpt + 1).Select
       
        ActiveSheet.Paste
   
    Else
End If
Next m
Next r


End Sub

The aim of this code is to open a file which will sort the colomn of names into "lastname, firstname" and then compare that to the source document. If the names match, 9 cells will be copied then pasted into a targeted area of the source document. It will then repeat till the end of the target document. Any missing names will be not inputted.

I'm not sure what I did wrong, or what else I need to add. Could I get some guidance?

 

[kevin9999]

So, is it the case that you want the master file (columns O-W) filled with data from the file that you open - but from different columns (AQ, BC etc.) where the names in column C of the master file match the names in column EU of the 'source' file? If that's the case, there's probably a simpler way of doing it than the path you're heading down, but I'm not going to recreate your files to test the code out so again I ask, could you provide a copy of the sheets involved using the XL2BB - Excel Range to BBCode, or alternatively share your file via Google Drive, Dropbox or similar file sharing platform. I cannot copy images.

 

[kevin9999]

Hi Tim,
Please try the following code on a copy of your workbook:

Option Explicit
Option Compare Text
Sub Tim_NSW()
    Application.ScreenUpdating = False
    Dim wb1 As Workbook, wb2 As Workbook
    Set wb1 = ThisWorkbook
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = wb1.Worksheets("NSW Data")
    Dim a, b, c, LRow As Long
    LRow = ws1.Cells(Rows.Count, "C").End(xlUp).Row
    
    a = ws1.Range("C4:W" & ws1.Cells(Rows.Count, "C").End(xlUp).Row)
    ReDim c(1 To LRow - 3, 1 To 9)
    With ws1
        .Range("O4:W" & LRow).ClearContents
        .Range("C4:C" & LRow).Value = Application.Trim(.Range("C4:C" & LRow))
    End With
    
    Dim FileToOpen
    FileToOpen = Application.GetOpenFilename(Title:="Get NSW source data", _
    FileFilter:="Excel Files (*.xls*), *xls*")
    If FileToOpen <> False Then Set wb2 = Application.Workbooks.Open(FileToOpen)
    
    Set ws2 = wb2.Worksheets(1)
    If ws2.AutoFilterMode Then ws2.AutoFilter.ShowAllData
    With ws2.Range("EU2:EU" & ws2.Cells(Rows.Count, "E").End(xlUp).Row)
        .FormulaR1C1 = "=TRIM(CONCAT(RIGHT(RC5,LEN(RC5)-FIND("" "",RC5)),"", "",LEFT(RC5,FIND("" "",RC5)-1)))"
        .Value2 = .Value2
    End With
    
    b = ws2.Range("AQ2:EU" & ws2.Cells(Rows.Count, "EU").End(xlUp).Row)
    Dim i As Long, j As Long, k As Long
    For i = 1 To UBound(a, 1)
        For j = 1 To UBound(b, 1)
            If a(i, 1) = b(j, 109) Then
                c(i, 1) = b(j, 1): c(i, 2) = b(j, 13): c(i, 3) = b(j, 24): c(i, 4) = b(j, 34): c(i, 5) = b(j, 46)
                c(i, 6) = b(j, 56): c(i, 7) = b(j, 71): c(i, 8) = b(j, 82): c(i, 9) = b(j, 98)
                Exit For
            End If
        Next j
    Next i
    With ws1
        .Range("O4").Resize(UBound(c, 1), UBound(c, 2)).Value = c
        With .Range("O4:W" & LRow)
            .Replace "NA", "", xlWhole
            .Replace "0%", "", xlWhole
        End With
    End With
    wb2.Close False
    Application.ScreenUpdating = True
End Sub

 

[TimmyTime]

Hi Tim,
Please try the following code on a copy of your workbook:

Option Explicit
Option Compare Text
Sub Tim_NSW()
    Application.ScreenUpdating = False
    Dim wb1 As Workbook, wb2 As Workbook
    Set wb1 = ThisWorkbook
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = wb1.Worksheets("NSW Data")
    Dim a, b, c, LRow As Long
    LRow = ws1.Cells(Rows.Count, "C").End(xlUp).Row
   
    a = ws1.Range("C4:W" & ws1.Cells(Rows.Count, "C").End(xlUp).Row)
    ReDim c(1 To LRow - 3, 1 To 9)
    With ws1
        .Range("O4:W" & LRow).ClearContents
        .Range("C4:C" & LRow).Value = Application.Trim(.Range("C4:C" & LRow))
    End With
   
    Dim FileToOpen
    FileToOpen = Application.GetOpenFilename(Title:="Get NSW source data", _
    FileFilter:="Excel Files (*.xls*), *xls*")
    If FileToOpen <> False Then Set wb2 = Application.Workbooks.Open(FileToOpen)
   
    Set ws2 = wb2.Worksheets(1)
    If ws2.AutoFilterMode Then ws2.AutoFilter.ShowAllData
    With ws2.Range("EU2:EU" & ws2.Cells(Rows.Count, "E").End(xlUp).Row)
        .FormulaR1C1 = "=TRIM(CONCAT(RIGHT(RC5,LEN(RC5)-FIND("" "",RC5)),"", "",LEFT(RC5,FIND("" "",RC5)-1)))"
        .Value2 = .Value2
    End With
   
    b = ws2.Range("AQ2:EU" & ws2.Cells(Rows.Count, "EU").End(xlUp).Row)
    Dim i As Long, j As Long, k As Long
    For i = 1 To UBound(a, 1)
        For j = 1 To UBound(b, 1)
            If a(i, 1) = b(j, 109) Then
                c(i, 1) = b(j, 1): c(i, 2) = b(j, 13): c(i, 3) = b(j, 24): c(i, 4) = b(j, 34): c(i, 5) = b(j, 46)
                c(i, 6) = b(j, 56): c(i, 7) = b(j, 71): c(i, 8) = b(j, 82): c(i, 9) = b(j, 98)
                Exit For
            End If
        Next j
    Next i
    With ws1
        .Range("O4").Resize(UBound(c, 1), UBound(c, 2)).Value = c
        With .Range("O4:W" & LRow)
            .Replace "NA", "", xlWhole
            .Replace "0%", "", xlWhole
        End With
    End With
    wb2.Close False
    Application.ScreenUpdating = True
End Sub

Thanks! Works like a charm

 

[kevin9999]

Thanks! Works like a charm

Happy to help & thanks for the feedback