excelvbanested-loopstype-mismatch

I keep getting Type Mismatch, setting column type to Integer


Per suggestions, I set the columns I'm using to a Const reference. This works as long as I don't declare a column as an Integer or Long. Integer or Long returns a "compile Error, type mismatch."

When I comment out any Integer or Long columns (Plt_PltNum, Proj_1stPlate, and Proj_LastPlate) and just reference the range in the loop, the code does run, although it does not return the information I need.

I suspect that VB isn't treating the integer columns as integers, hence the >= and <= conditions don't really work.

Sub ProjectPlateLoops()

    'define workbooks and worksheets
    Dim wb As Workbook, ws As Worksheet, PlateSheet As Worksheet, ProjSheet As Worksheet
    Dim pltNum As Integer
    Dim lrProj As Long, lrPlate As Long, i As Long, j As Long
    Dim Farm As String, Batch As String
    Dim projcode
    Dim pltprojcode
    
    Set wb = ActiveWorkbook 'or ActiveWorkbook?
    Set ws = ActiveSheet
    Set PlateSheet = wb.Worksheets("Plate_Analysis")
    Set ProjSheet = wb.Worksheets("Project_Analysis")
    
    'last rows in Project Analysis/Plate sheets (call separate function for this)
    lrProj = LastOccupiedRow(ProjSheet)
    lrPlate = LastOccupiedRow(PlateSheet)
    
    'column constants
    ' Plate Sheet
    'Const Plt_PltNum As Long = "E" ' plate number on PltSheet
    Const Plt_ProjID_Col As String = "F" ' proj code on PltSheet
    Const Plt_Batch_Col As String = "G" ' batch on PltSheet
    Const Plt_Farm_Col As String = "H" ' farm name on PltShee
    ' Proj Sheet
    Const Proj_ProjID_Col As String = "F" ' proj code on ProjSheet
    Const Proj_Farm_Col As String = "D" ' farm name on ProjSheet
    Const Proj_Batch_Col As String = "E" ' batch on ProjSheet
    'Const Proj_1stPlate As Integer = "J" ' first plate # in batch from ProjSheet
    'Const Proj_LastPlate As Integer = "L" ' last plate # in batch from ProjSheet

    
    ' Create Loop; if 3 conditions are met, then print Batch and Farm from Project sheet to Plate sheet
    ' Condition 1: pltprojcode = projcode
    ' Condition 2 & 3: pltNum >= firstplatenum AND <= lastplatenum
    For i = 3 To lrPlate
        pltprojcode = PlateSheet.Cells(i, Plt_ProjID_Col).Value2
          Debug.Print "i: " & (i) & ", " & "Plate ProjCode from PlateSheet: " & (pltprojcode)
        pltNum = PlateSheet.Cells(i, "E").Value2
          Debug.Print "i: " & (i) & ", " & "Plate Number from PlateSheet: " & (pltNum)
        For j = 3 To lrProj
            If ProjSheet.Cells(j, Proj_ProjID_Col).Value2 = pltprojcode Then
            projcode = ProjSheet.Cells(j, Proj_ProjID_Col).Value2
                Debug.Print "ProjCode from ProjSheet: "; j & ", " & (projcode)
              Farm = ProjSheet.Cells(j, Proj_Farm_Col).Value2
                Debug.Print "j: " & (j) & ", " & "Farm: " & (Farm)
              Batch = ProjSheet.Cells(j, Proj_Batch_Col).Value2
                Debug.Print "j: " & (j) & ", " & "Batch: " & (Batch)
              On Error Resume Next
              End If
                If pltNum >= ProjSheet.Cells(i, "J").Value2 And _
                pltNum <= ProjSheet.Cells(i, "L").Value2 Then
                PlateSheet.Cells(i, Plt_Farm_Col).Value2 = Farm 'farm
                PlateSheet.Cells(i, Plt_Batch_Col).Value2 = Batch 'batch
            On Error Resume Next
           End If
        Next j
    Next i

End Sub

Function LastOccupiedRow(ws As Worksheet) As Long
    Dim f As Range
    Set f = ws.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
    If Not f Is Nothing Then LastOccupiedRow = f.Row
End Function

Interestingly, if I run the code now, the only Debug.Print values that show up are in the "i" loop. If I comment out the i loop Debug.Print, the "j" debug values will print, but only the same lines over and over again, as if only one line of data actually matches all the criteria.


Solution

  • A VBA Lookup

    A Quick Fix

    Sub RetrieveBatchAndFarm()
    
        ' Define constants.
        
        Const SRC_SHEET_NAME As String = "Project_Analysis"
        Const SRC_FIRST_ROW As Long = 3
        Const SRC_PROJ_ID As String = "F" ' 2. ... here, if found...
        Const SRC_MIN_PLATE As String = "J" ' 4. ... is between...
        Const SRC_MAX_PLATE As String = "L" ' 5. ... these two, if so...
        Const SRC_BATCH As String = "E" ' 6. ... and copy this...
        Const SRC_FARM As String = "D" ' 8. ... then copy this...
        
        Const DST_SHEET_NAME As String = "Plate_Analysis"
        Const DST_FIRST_ROW As Long = 3
        Const DST_PROJ_ID As String = "F" ' 1. Find this...
        Const DST_PLATE As String = "E" ' 3. ... then check if this...
        Const DST_BATCH As String = "G" ' 7. ... here,...
        Const DST_FARM As String = "H" ' 9. ... here.
        
        ' Reference the workbook and worksheets, and determine the last rows.
        
        Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
        
        Dim sws As Worksheet: Set sws = wb.Sheets(SRC_SHEET_NAME)
        Dim sLastRow As Long: sLastRow = GetLastRow(sws)
        
        Dim dws As Worksheet: Set dws = wb.Sheets(DST_SHEET_NAME)
        Dim dLastRow As Long: dLastRow = GetLastRow(dws)
        
        ' Loop: if 'ProcId's are equal then if 'Plate' is between 'Plates'
        ' then copy 'Batch' and 'Farm'.
        
        Dim sr As Long, sFarm As String, sBatch As String, sProcId As String
        Dim dr As Long, dPlate As Double, dProcId As String
        
        For dr = DST_FIRST_ROW To dLastRow
            dProcId = CStr(dws.Cells(dr, DST_PROJ_ID).Value)
            For sr = SRC_FIRST_ROW To sLastRow
                sProcId = CStr(sws.Cells(sr, SRC_PROJ_ID).Value)
                If StrComp(sProcId, dProcId, vbTextCompare) = 0 Then ' is equal
                    dPlate = dws.Cells(dr, DST_PLATE).Value
                    If dPlate >= sws.Cells(sr, SRC_MIN_PLATE).Value _
                            And dPlate <= sws.Cells(sr, SRC_MAX_PLATE).Value Then
                        sBatch = sws.Cells(sr, SRC_BATCH).Value
                        sFarm = sws.Cells(sr, SRC_FARM).Value
                        dws.Cells(dr, DST_BATCH).Value = sBatch
                        dws.Cells(dr, DST_FARM).Value = sFarm
                        Exit For
                    End If
               End If
            Next sr
        Next dr
        
        ' Inform.
        MsgBox "Batch and Farm retrieved.", vbInformation
    
    End Sub
    
    Function GetLastRow(ws As Worksheet) As Long
        Dim rg As Range
        Set rg = ws.Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious)
        If Not rg Is Nothing Then GetLastRow = rg.Row
    End Function